MAPX查找最近的实体

葡萄

iTimesThrough = iTimesThrough + 1

Loop Until objMap.Layers(strSearchLayer).Selection.Count > 0 Or iTimesThrough > 10
'Test to see if there was anything selected
If objMap.Layers(strSearchLayer).Selection.Count = 0 Then
Nearest = False
Exit Function
End If
'Find closest feature in selection collection
first = True
For Each ft In objMap.Layers(strSearchLayer).Selection
'get the distance to the selected object
sngTemp = objMap.Distance(dblX, dblY, ft.CenterX, ft.CenterY)
'is this closest so far?
If first Or (sngTemp < sngLowestDist) Then
' replace feature details
sngLowestDist = sngTemp
strItemName = ft.Name
' rect = ft.bounds
X1 = ft.Bounds.XMin
Y1 = ft.Bounds.YMin
X2 = ft.Bounds.XMax
Y2 = ft.Bounds.YMax
End If
first = False
Next
'Clear the selection so that you don't see the highlight pattern
objMap.Layers(strSearchLayer).Selection.ClearSelection
' return success
Nearest = True
End Function


Private Sub Form_Load()
Map1.CreateCustomTool 101, miToolTypePoint, miRadiusSelectCursor
End Sub


Private Sub Map1_ToolUsed(ByVal ToolNum As Integer, ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double, ByVal Distance As Double, ByVal Shift As Boolean, ByVal Ctrl As Boolean, EnableDefault As Boolean)
If ToolNum = 101 Then
Dim Radius As Single
Dim itemName As String
Dim xa As Double
Dim ya As Double
Dim xb As Double
Dim yb As Double
Dim strLyr As String
strLyr = "US Major Cities"
Radius = 500
If (Nearest(Map1, strLyr, X1, Y1, Radius, itemName, xa, ya, xb, yb)) Then
Text1 = itemName
Else
Text1 = "No Major City near there!"
End If
End If
End Sub