jane2004
路人甲
路人甲
  • 注册日期2005-05-27
  • 发帖数12
  • QQ
  • 铜币151枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:958回复:0

请各位帮忙看看有关捕捉点画多边形的程序

楼主#
更多 发布于:2005-07-22 14:42
<P>我做了一个捕捉点的函数,但用于画多边形时有问题:如果是第二个点,鼠标移动时捕捉到点,就出现和第一点的连线,不会随鼠标移动消失,直到捕捉到另外一点才变为第一点和另一点的连线。如果不用捕捉功能,画多边形是正确的。</P>
<P>画多边形用的是INewPolygonFeedback</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)</P>
<P>    Dim pPoint As esricore.IPoint</P>
<P>    Set pPoint = New Point<BR>    pPoint.PutCoords mapX, mapY</P>
<P>If (Not m_bToolInUse) Then</P>
<P>        m_bToolInUse = True</P>
<P>         Set m_pFeedback = New esricore.NewPolygonFeedback<BR>          Set pPolyFeed = m_pFeedback<BR>          If gIsSnaping And (Not pSnapPoint Is Nothing) Then<BR>             pPolyFeed.Start pSnapPoint<BR>          Else<BR>             pPolyFeed.Start pPoint<BR>          End If</P>
<P>          If (Not m_pFeedback Is Nothing) Then Set m_pFeedback.Display =     pActiveView.ScreenDisplay</P>
<P>else</P>
<P>If (TypeOf m_pFeedback Is INewPolygonFeedback) Then<BR>      Set pPolyFeed = m_pFeedback</P>
<P>     pPolyFeed.AddPoint pPoint</P>
<P>end if</P>
<P>end if</P>
<P>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)<BR>Dim pPoint As esricore.IPoint</P>
<P>  Set pPoint = New Point<BR>  pPoint.PutCoords mapX, mapY<BR>     <BR>  ''*****snap point<BR>  If gIsSnaping Then<BR>     If m_CurLayer Is Nothing Then<BR>        Exit Sub<BR>     End If<BR>     Set pSnapPoint = GetSnapPoint(pPoint)'如果注释掉画多边形是正确的<BR>  End If</P>
<P>If (Not m_pFeedback Is Nothing) Then<BR>        m_pFeedback.MoveTo pPoint<BR>        Set m_pPoint = pPoint<BR>End If</P>
<P>end sub</P>
<P>Function GetSnapPoint(ByVal pPoint As esricore.IPoint) As IPoint<BR>    <BR>     Dim pOutPoint As IPoint<BR>     Dim pFeature As esricore.IFeature<BR>     Dim searchRadius As Double<BR>      <BR>     Set gSnapPoint = Nothing<BR>     searchRadius = wjh_ConvertPixelsToMapUnits(MapControl1.Map, 7)<BR>    <BR>     '创建矩形来搜索相交feature<BR>     Dim pEnvelope As IEnvelope<BR>     Set pEnvelope = New Envelope<BR>     pEnvelope.XMin = pPoint.x - 5<BR>     pEnvelope.XMax = pPoint.x + 5<BR>     pEnvelope.YMin = pPoint.y - 5<BR>     pEnvelope.YMax = pPoint.y + 5<BR>  <BR>     Dim pSpatialFilter As ISpatialFilter<BR>     Set pSpatialFilter = New SpatialFilter<BR>     pSpatialFilter.SpatialRel = esriSpatialRelIntersects<BR>     pSpatialFilter.GeometryField = "shape"<BR>     Set pSpatialFilter.Geometry = pEnvelope<BR>  <BR>     '只对当前层进行搜索<BR>     Dim pFeatureLayer As IFeatureLayer<BR>     Set pFeatureLayer = m_CurLayer 'MapControl1.Map.Layer(0)<BR>     Dim pFeatureCursor As IFeatureCursor<BR>     Set pFeatureCursor = pFeatureLayer.Search(pSpatialFilter, False)<BR>  <BR>     If Not pFeatureCursor Is Nothing Then<BR>        Set pFeature = pFeatureCursor.NextFeature<BR>        <BR>        '得到最近节点<BR>        If Not pFeature Is Nothing Then<BR>           Dim pMultiPt As IMultipoint<BR>           Dim pPtCol As IPointCollection<BR>           Dim pOnePtCol As IPointCollection<BR>           Dim pNewPtCol As IPointCollection<BR>      <BR>           Set pOnePtCol = pFeature.ShapeCopy<BR>           Set pMultiPt = New Multipoint<BR>           Set pPtCol = pMultiPt<BR>           pPtCol.AddPointCollection pOnePtCol<BR>       <BR>           '把所有相交的feature的节点合并为一个multipoint<BR>           Set pFeature = pFeatureCursor.NextFeature<BR>           Do While Not pFeature Is Nothing<BR>              Set pNewPtCol = pFeature.ShapeCopy<BR>              pPtCol.AddPointCollection pNewPtCol<BR>              Set pFeature = pFeatureCursor.NextFeature<BR>           Loop</P>
<P>           Dim pTop As ITopologicalOperator<BR>           <BR>           Set pTop = pMultiPt</P>
<P>           Dim pProximityOperator As IProximityOperator<BR>           Set pProximityOperator = pTop<BR>           '得到最近节点<BR>           Set pOutPoint = pProximityOperator.ReturnNearestPoint(pPoint, 0)<BR>           <BR>           If Not pOutPoint Is Nothing Then<BR>              'MapControl1.FlashShape pOutPoint, 3, 300<BR>              '判断最近节点是否在设定范围内<BR>              Set pProximityOperator = pOutPoint<BR>              If pProximityOperator.ReturnDistance(pPoint) <= searchRadius Then<BR>                 Set gSnapPoint = pOutPoint<BR>                 frmMain.MapControl1.Refresh esriViewForeground<BR>              End If<BR>           End If<BR>        End If<BR>  End If<BR>  Set GetSnapPoint = pOutPoint<BR>  <BR>End Function</P>
<P>后来我发现是刷新的问题,把frmMain.MapControl1.Refresh esriViewForeground这句注释掉就好了,只是刷新的有点慢</P>
<P>但没有这句话又无法刷新从而画出捕捉点的标志,怎么办啊?</P>
喜欢0 评分0
游客

返回顶部