当前位置:甜馍馍地理信息网 >> 地理信息系统GIS >> 组件式GIS >> 正文 >>  [阅读资讯:用代码实现ArcGIS中使用绘制的圆形选择要素]

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

[ 来源:互联网 | 时间:2007年12月08日 | 收藏本文 ] 【

相信熟悉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

【推荐本文】 【打印本页】 【返回顶部
最新文章
推荐文章