用代码实现ArcGIS中使用绘制的圆形选择要素

相信熟悉ArcGIS的朋友都知道只能使用面状选择，这可是一大遗憾。为了提高使用灵活性本文将以实际代码实现圆形选择要素，大大方便劳动。使用绘制的圆形选择要素，算是弥补ESRI只能使用面状选择的遗憾吧？？？

Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
　Dim pMxApp As IMxApplication
　Dim pMxDoc As IMxDocument
　Dim pActiveView As IActiveView
　Dim pRubberCirc As IRubberBand
　Dim pCircArc As ICircularArc
　Dim pGeo As Igeometry
　Dim pMap As Imap
　Dim pMapPoint As WKSPoint
　Dim pDevPoint As tagPOINT
　Dim pDisplayTransformation As IDisplayTransformation

　Set pMxApp = Application
　Set pMxDoc = Application.Document
　Set pMap = pMxDoc.FocusMap
　Set pActiveView = pMap
　' Create a new RubberCircle
　Set pRubberCirc = New RubberCircle
　' Return a new CircularArc from the tracker object using TrackNew
　Set pCircArc = pRubberCirc.TrackNew(pMxDoc.ActiveView.ScreenDisplay, Nothing)

　'Convert radius to screen pixels
　Set pDisplayTransformation = pMxApp.Display.DisplayTransformation

　pMapPoint.x = pCircArc.Radius
　pMapPoint.y = pCircArc.Radius

　pDisplayTransformation.TransformCoords pMapPoint, pDevPoint, 1, 10

　'Set the search tolerance
　pMxDoc.SearchTolerancePixels = pDevPoint.x
　Dim pSegColl As ISegmentCollection
　Set pSegColl = New Polygon
　pSegColl.AddSegment pCircArc
　Set pGeo = pSegColl

　' pMxDoc.SearchTolerance, pMxDoc.SearchTolerance, False

　'Refresh the old selection to erase it
　pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
　'Perform the selection using a point created on mouse down
　pMap.SelectByShape pGeo, pMxApp.SelectionEnvironment, False
　'Refresh again to draw the new selection
　pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
End Sub

Private Function UIToolControl1_Message() As String
　UIToolControl1_Message = "Select features by dragging a circle"
End Function

Private Function UIToolControl1_ToolTip() As String
　UIToolControl1_ToolTip = "Select features"
End Function