mod_findfeature.bas

来自「AO的开发平台」· BAS 代码 · 共 49 行

Attribute VB_Name = "Mod_FindFeature"
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