在mo中实现编辑多边形节点，缓冲区[分享代码]

运行界面



Option Explicit
Dim editpoly As MapObjects2.Polygon
Dim bufferpoly As MapObjects2.Polygon
Dim pts As New MapObjects2.Points

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
 
  Dim i As Integer
  Dim pt As New MapObjects2.Point
  Dim thisDist As Single
  Dim shortDist As Single
  Dim shortDistPtIndex As Integer
  
If Option1.Value = True Then

   Set editpoly = Map1.TrackPolygon
    Set pts = editpoly.Parts(0)
  
End If

If Option2.Value = True Then
'Remove the vertex closest to the user-clicked point

  If editpoly.Parts.Count > 0 Then
  
   ' 节点少于3个的时候，不删除或退出
  If pts.Count <= 3 Then Exit Sub
  
   ' 识别最短距离变量
shortDist = 999999999
  
  
   Set pt = Map1.ToMapPoint(x, y)
  
  
  '  在多边形节点集合pts中循环
  For i = 0 To pts.Count - 1
    
    thisDist = pt.DistanceTo(pts(i))
    If thisDist < shortDist Then
      shortDist = thisDist
      shortDistPtIndex = i
    End If
    
  Next
  
  pts.Remove shortDistPtIndex

  End If
End If


If Option3.Value = True Then
  If editpoly.Parts.Count <> 0 Then

 '  识别最短距离变量
shortDist = 999999999
  
  '   用户点的坐标
Set pt = Map1.ToMapPoint(x, y)

 For i = 0 To pts.Count - 1
 
    thisDist = pt.DistanceTo(pts(i))
    If thisDist < shortDist Then
      shortDist = thisDist
      shortDistPtIndex = i
    End If
  
 Next
  
   pts.Set shortDistPtIndex, pt
 
  End If
End If


If Option4.Value = True Then
  
  
  If editpoly.Parts.Count <> 0 Then
    shortDist = 999999999
    Set pt = Map1.ToMapPoint(x, y)

      '找到最近的坐标.  
     For i = 0 To pts.Count - 2
         thisDist = pt.DistanceToSegment(pts(i), pts(i + 1))
         If thisDist < shortDist Then
           shortDist = thisDist
           shortDistPtIndex = i + 1
         End If
      Next
      
      '   得到最近的点，进行添加，插入、移动节点，
      '  If it is, then "Add" the point to the bottom of the "pts" collection.
      '  If it is not, then "Insert" the point into the proper place.
      thisDist = pt.DistanceToSegment(pts(pts.Count - 1), pts(0))
      If thisDist < shortDist Then
          pts.Add pt
       Else
          pts.Insert shortDistPtIndex, pt
      End If
  End If
End If

Map1.TrackingLayer.Refresh True

End Sub

Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As Stdole.OLE_HANDLE)

If Not editpoly Is Nothing Then
  Dim sym As New MapObjects2.Symbol

   sym.SymbolType = moFillSymbol
   sym.Style = moVerticalFill
   sym.Color = moNavy
    
    
   Map1.DrawShape editpoly, sym
    
 '   节点用红色表示
    Dim pt As New MapObjects2.Point
    sym.SymbolType = moPointSymbol
    sym.Style = moSquareMarker
    sym.Color = moRed
    For Each pt In pts
       Map1.DrawShape pt, sym
    Next pt
 End If
 
 '   绘制缓冲区并填充        
 If Not bufferpoly Is Nothing Then
   Dim buffersym As New MapObjects2.Symbol
   buffersym.SymbolType = moFillSymbol
   buffersym.Style = moHorizontalFill
   buffersym.Color = moYellow
   buffersym.OutlineColor = moYellow
   buffersym.Size = 3
   Map1.DrawShape bufferpoly, buffersym
 End If
 
End Sub

Private Sub cmdBuffer_Click()

If Not editpoly Is Nothing Then

  Set bufferpoly = editpoly.Buffer(cboBufferDist.List(cboBufferDist.ListIndex))
  Map1.Refresh

End If

End Sub

注意：自己更改数据目录和数据内容
Private Sub Form_Load()

Dim dc As New MapObjects2.DataConnection
Dim lyr As New MapObjects2.MapLayer

dc.Database = App.Path & "\data"
dc.Connect

'  添加数据Mexico states
Set lyr.GeoDataset = dc.FindGeoDataset("mexico")
Map1.Layers.Add lyr
lyr.Symbol.Color = moPaleYellow

'Load the cboBufferDist with the value "100000"
cboBufferDist.ListIndex = 4

End Sub

不错。谢谢斑竹！！

不错。3Q

thx a lot!!!!!!!!!

谢谢，我正想找着方面的资料