关于捕捉

<P>急需用ArcgisEngine实现捕捉功能,不知道哪位高人有没有相关的例子,如果有,请发给我,不胜感谢.</P>
<P>emai:giswind@163.com</P>

楼上的兄弟有好方法说出来哈:)<img src="images/post/smile/dvbbs/em02.gif" />

这方法不好,效率太低.

<P>下面这个程序演示了捕捉功能，你可以看看，一个窗体上的，控件自己加吧</P>
<P>Option Explicit</P>
<P>Private Sub Check1_Click()
  If Check1.Value = 1 Then
    Picture1.Visible = True
  Else
    Picture1.Visible = False
  End If
End Sub</P>
<P>Private Sub MapControl1_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
  MapControl1.Extent = MapControl1.TrackRectangle
End Sub</P>
<P>Private Sub MapControl1_OnMouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
  
  
  'MapControl1.ActiveView.PartialRefresh esriViewForeground, Nothing, Nothing
  
  
  
  Dim pPoint As IPoint
  Set pPoint = New Point
  pPoint.PutCoords mapX, mapY
  
  Dim pEnvelope As IEnvelope
  Set pEnvelope = New Envelope
  
  pEnvelope.XMin = pPoint.x - 1
  pEnvelope.XMax = pPoint.x + 1
  pEnvelope.YMin = pPoint.y - 1
  pEnvelope.YMax = pPoint.y + 1
  
  Dim pSpatialFilter As ISpatialFilter
  Set pSpatialFilter = New SpatialFilter
  pSpatialFilter.SpatialRel = esriSpatialRelIntersects
  pSpatialFilter.GeometryField = "shape"
  Set pSpatialFilter.Geometry = pEnvelope
  
  Dim pFeatureLayer As IFeatureLayer
  Set pFeatureLayer = MapControl1.Map.Layer(0)
  Dim pFeatureCursor As IFeatureCursor
  Set pFeatureCursor = pFeatureLayer.Search(pSpatialFilter, False)
  '
  If Not pFeatureCursor Is Nothing Then
    Dim pFeature As IFeature
    Set pFeature = pFeatureCursor.NextFeature
    If Not pFeature Is Nothing Then
      Picture1.Visible = True
    Else
      Picture1.Visible = False
    End If
    If Not pFeature Is Nothing Then
      Dim pTop As ITopologicalOperator
      Set pTop = pFeature.Shape
      Set pFeature = pFeatureCursor.NextFeature
      Do While Not pFeature Is Nothing
        
        Dim pNewTop As ITopologicalOperator
        Set pNewTop = pTop.Union(pFeature.Shape)
        Set pTop = pNewTop
        Set pFeature = pFeatureCursor.NextFeature
      Loop
      
      Dim pProximityOperator As IProximityOperator
      Set pProximityOperator = pTop
      Dim pOutPoint As IPoint
      Set pOutPoint = pProximityOperator.ReturnNearestPoint(pPoint, 0)
      'MapControl1.FlashShape pOutPoint, 3, 300
      Dim pL As Long
      Dim pT As Long
      MapControl1.FromMapPoint pOutPoint, pL, pT
  
      Picture1.Left = pL - Picture1.Width / 2
      Picture1.Top = pT - Picture1.Height / 2
    End If
  End If</P>

<P>  
  'pDisplay.FinishDrawing
  
End Sub</P>