?? mod_findfeature.bas
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -