How to implement "select by location" by VBA and ArcObject ?

GarySham

Dear all,

I have two polygon feature classes, polygon A and polygon B.

I would like to write a VBA to perform a select by location function to find out which polygon(s) in polygon B is/are intersect with a selected polygon in polygon A which is selected by a user.

I know, I can use "ISpatialFilter" to do this, but don't know how to implement it in VBA. Would you mind provide some sample code/hints for me ?

Regards
Gary

KingsleyPayne

Sub SpatialFilter()

Dim pMxd As IMxDocument
Set pMxd = ThisDocument

Dim pEnumFeature As IEnumFeature
Set pEnumFeature = pMxd.FocusMap.FeatureSelection

pEnumFeature.Reset

Dim pSearchFeature As IFeature
Set pSearchFeature = pEnumFeature.Next

If (pSearchFeature Is Nothing) Then
    MsgBox "Please select a feature to search."
    Exit Sub
End If

pMxd.FocusMap.ClearSelection

Dim pLayer As ILayer
Dim pSearchLayer As IFeatureLayer
Dim pFeatureLayer As IFeatureLayer

Dim i As Integer

For i = 0 To pMxd.FocusMap.LayerCount - 1
    Set pLayer = pMxd.FocusMap.Layer(i)
    
    If pLayer.Name = "Roads" Then
        Set pSearchLayer = pLayer
        Exit For
    End If
Next

If (pSearchLayer Is Nothing) Then
    MsgBox "Roads layer not found!"
    Exit Sub
End If

For i = 0 To pMxd.FocusMap.LayerCount - 1
    Set pLayer = pMxd.FocusMap.Layer(i)
    
    If pLayer.Name = "Road Assets" Then
        Set pFeatureLayer = pLayer
        Exit For
    End If
Next

If (pSearchLayer Is Nothing) Then
    MsgBox "Road Assets layer not found!"
    Exit Sub
End If

Dim pSpatialFilter As ISpatialFilter
Set pSpatialFilter = New SpatialFilter

Dim pTopoOp As ITopologicalOperator
Set pTopoOp = pSearchFeature.Shape

' You might need to buffer the search geometry in certain cases.
' Use a buffer value of 0 to search using the original geometry.

Dim pSearchGeometry As IGeometry
Set pSearchGeometry = pTopoOp.Buffer(10)

Set pSpatialFilter.Geometry = pSearchGeometry
pSpatialFilter.GeometryField = pSearchLayer.FeatureClass.ShapeFieldName
pSpatialFilter.SpatialRel = esriSpatialRelIntersects

Dim pFeatureCursor As IFeatureCursor
Set pFeatureCursor = pFeatureLayer.Search(pSpatialFilter, False)

Dim pFeature As IFeature
Dim FeatureCount As Integer

Set pFeature = pFeatureCursor.NextFeature

Do While Not pFeature Is Nothing
    FeatureCount = FeatureCount + 1
    pMxd.FocusMap.SelectFeature pFeatureLayer, pFeature
    Set pFeature = pFeatureCursor.NextFeature
Loop

If (FeatureCount = 1) Then
    MsgBox FeatureCount & " feature found."
Else
    MsgBox FeatureCount & " features found."
End If

Dim pActiveView As IActiveView
Set pActiveView = pMxd.FocusMap

pActiveView.Refresh

End Sub