giswind
路人甲
路人甲
  • 注册日期2003-08-06
  • 发帖数16
  • QQ
  • 铜币182枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1580回复:3

关于捕捉

楼主#
更多 发布于:2005-05-08 09:01
<P>急需用ArcgisEngine实现捕捉功能,不知道哪位高人有没有相关的例子,如果有,请发给我,不胜感谢.</P>
<P>emai:giswind@163.com</P>
[此贴子已经被作者于2005-5-8 14:34:51编辑过]
喜欢0 评分0
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
1楼#
发布于:2005-05-09 11:41
回复:(giswind)关于捕捉
<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>
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
dengfujun
路人甲
路人甲
  • 注册日期2003-09-22
  • 发帖数91
  • QQ
  • 铜币366枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2005-05-11 19:03
这方法不好,效率太低.
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
3楼#
发布于:2005-05-11 20:03
楼上的兄弟有好方法说出来哈:)<img src="images/post/smile/dvbbs/em02.gif" />
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
游客

返回顶部