空间分析的简单应用__GIS动力站_ArcGIS|开源|虚拟地理环境|算法|工程|信息空间化|WebGIS

在地图上画矩形或者圆形可以通过INewCircleFeedback接口实现，画矩形同理，只需转换使用的接口就可以了，以下以画圆形为例（该代码是在ArcMap的VBA环境下，建立用户控件使用的）：
Private m_pDoc As IMxDocument
Private m_pAV As IActiveView
Private m_pScrD As IScreenDisplay
Private m_pNewCircFeedback As INewCircleFeedback

Private Function UIToolControl1_Enabled() As Boolean
'Set the ToolControl to enabled (disabled by default if any code is present in this event)
UIToolControl1_Enabled = True

'Check that we have a reference to the ActiveView and ScreenDisplay
If m_pScrD Is Nothing Then
    Set m_pDoc = Application.Document
    Set m_pAV = m_pDoc.ActiveView
    Set m_pScrD = m_pAV.ScreenDisplay
End If
End Function

Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
Dim pPnt As IPoint

' Get the current mouse location in Map Units
Set pPnt = m_pScrD.DisplayTransformation.ToMapPoint(x, y)

' Check that user is not using an existing feedback
If m_pNewCircFeedback Is Nothing Then

    ' Create a NewCircleFeedback object
    Set m_pNewCircFeedback = New NewCircleFeedback

    'Set the Feedback's Display and StartPoint
    Set m_pNewCircFeedback.Display = m_pScrD
    m_pNewCircFeedback.Start pPnt

End If
End Sub

Private Sub UIToolControl1_MouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)

' Check if the user is currently using the feedback
If Not m_pNewCircFeedback Is Nothing Then
    Dim pPnt As IPoint
    'Move the Feedback to the current mouse location
    Set pPnt = m_pScrD.DisplayTransformation.ToMapPoint(x, y)
    m_pNewCircFeedback.MoveTo pPnt
End If
End Sub

Private Sub UIToolControl1_MouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
Dim pCircArc As IGeometry

' Check if the user is currently using the feedback
If Not m_pNewCircFeedback Is Nothing Then
    'Get the geometry (ICircularArc) returned from the feedback
    Set pCircArc = m_pNewCircFeedback.Stop

    ' If it is valid then create a CircleElement on the ActiveView using the 'AddCreateElement' procedure
    If Not pCircArc Is Nothing Then
      AddCreateElement pCircArc, m_pAV
      m_pAV.Refresh
    End If

    ' Set the feedback to nothing for the next use
    Set m_pNewCircFeedback = Nothing
End If
End Sub

Private Sub AddCreateElement(pCircArc As ICircularArc, pAV As IActiveView)
' Takes an ICircularArc and IActiveView and creates a CircleElement in the ActiveView's BasicGraphicsLayer
Dim pElemFillShp As IFillShapeElement
Dim pElem As IElement
Dim pGraCont As IGraphicsContainer
Dim pSFSym As ISimpleFillSymbol
Dim pRGB As IRgbColor
Dim pSegColl As ISegmentCollection

' Create a new Polygon object and access the ISegmentCollection interface to add a segment
Set pSegColl = New Polygon
pSegColl.AddSegment pCircArc

' Create a new circleelement and use the IElement interface to set the its Geometry
Set pElem = New CircleElement
pElem.Geometry = pSegColl

' QI for the IFillShapeElement interface so that the Symbol property can be set
Set pElemFillShp = pElem

' Create a new RGBColor
Set pRGB = New RgbColor
With pRGB
    .Red = 198
    .Green = 255
    .Blue = 214
End With

' Create a new SimpleFillSymbol and set its Color and Style
Set pSFSym = New SimpleFillSymbol
pSFSym.Color = pRGB
pSFSym.Style = esriSFSSolid
pElemFillShp.Symbol = pSFSym

' QI for the IGraphicsContainer interface from the IActiveView, allows access to the BasicGraphicsLayer
Set pGraCont = pAV
'Add the element at Z order zero
pGraCont.AddElement pElemFillShp, 0
End Sub
至于搜索，只需在取得pCircArc后利用ISpatialFilter即可实现，代码如下：
Dim pFilter As IspatialFilter
Set pFilter = New SpatialFilter
With pFilter
    Set .Geometry = pCircArc
    .GeometryField = "SHAPE"
    .SpatialRel = esriSpatialRelIntersects
End With
dim featureCount as Integer
featurecount=pFeatureClass.FeatureCount pFilter
featurecount即为要搜索的pfeatureclass中的实体个数

原文:http://www.cnblogs.com/gispeng/archive/2007/05/22/755717.html

（本文已被浏览次）

发布人：admin
推荐给好友:

上篇新闻：
下篇新闻：