Find a Feature Programmatically

Created:7/6/2000
Description:

This sample code searches for a feature by looping through all of the map layers. The sample uses a UITool control to provide the MouseDown event and search point location. The search point is buffered using IEnvelope::Expand to increase the search tolerance and likelyhood of finding a feature. If you are using the Editor extension, you can alternatively use IEditor::CreateSearchShape to automatically expand the point envelope. The FindFeature function below, returns the first feature found.

How to use:
  1. Add a custom UIToolControl onto any toolbar and make sure the names of the control match the code. This sample assumes the control is called UIToolControl1.
  2. Paste the code into VBA.
  3. Select the tool and then click on a feature.
Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
  Dim pMxDoc As IMxDocument
  Dim pActiveView As IActiveView
  Dim pPoint As IPoint
  Dim pFeature As IFeature
  
  Set pMxDoc = Application.Document
  Set pActiveView = pMxDoc.FocusMap
  'Create a search point
  Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
  'Pass the point to the FindFeature function along with the Map and search tolerance
  Set pFeature = FindFeature(pMxDoc.SearchTolerance, pPoint, pMxDoc.FocusMap)
  'Message box the feature ID and feature class alias name
  If Not pFeature Is Nothing Then MsgBox pFeature.OID & " " & pFeature.Class.AliasName
End Sub

Private Function FindFeature(SearchTol As Double, pPoint As IPoint, pMap As IMap) As IFeature
  Dim pEnvelope As IEnvelope
  Dim pSpatialFilter As ISpatialFilter
  Dim pEnumLayer As IEnumLayer
  Dim pFeatureLayer As IFeatureLayer
  Dim pFeatureClass As IFeatureClass
  Dim pFeatureCursor As IFeatureCursor
  Dim pFeature As IFeature
  Dim pUID As New UID
  Dim ShapeFieldName As String
  
  If pMap.LayerCount = 0 Then Exit Function
  
  'Expand the points envelope to give better search results
  Set pEnvelope = pPoint.Envelope
  pEnvelope.Expand SearchTol, SearchTol, False
  
  'Create a new spatial filter and use the new envelope as the geometry
  Set pSpatialFilter = New SpatialFilter
  Set pSpatialFilter.Geometry = pEnvelope
  pSpatialFilter.SpatialRel = esriSpatialRelIntersects

  'Search each selectable feature layer for a feature
  'Return the first feature found
  pUID = "{40A9E885-5533-11D0-98BE-00805F7CED21}" 'IFeatureLayer
  Set pEnumLayer = pMap.Layers(pUID, False)
  pEnumLayer.Reset
  Set pFeatureLayer = pEnumLayer.Next
  Do While Not pFeatureLayer Is Nothing
    'Only search the selectable layers
    If pFeatureLayer.Selectable Then
      ShapeFieldName = pFeatureLayer.FeatureClass.ShapeFieldName
      Set pSpatialFilter.OutputSpatialReference(ShapeFieldName) = pMap.SpatialReference
      pSpatialFilter.GeometryField = pFeatureLayer.FeatureClass.ShapeFieldName
      Set pFeatureClass = pFeatureLayer.FeatureClass
      Set pFeatureCursor = pFeatureClass.Search(pSpatialFilter, False)  'Do the search
      Set pFeature = pFeatureCursor.NextFeature  'Get the first feature
      If Not pFeature Is Nothing Then
        Set FindFeature = pFeature  'Exit if feature is valid
        Exit Do
      End If
    End If
    Set pFeatureLayer = pEnumLayer.Next
  Loop

End Function