总有黎明
路人甲
路人甲
  • 注册日期2003-09-25
  • 发帖数59
  • QQ
  • 铜币276枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:2017回复:3

请教如何在mo中分割一条线段?十分感谢

楼主#
更多 发布于:2003-09-28 11:12
看到ao中提供split方法,请问在mo中如何实现
喜欢0 评分0
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15946
  • QQ554730525
  • 铜币25338枚
  • 威望15363点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
1楼#
发布于:2003-09-28 11:30
好,搞定!
程序界面:

程序数据:
<a href="attachment/200392811294014690.rar">200392811294014690.rar</a>

Option Explicit
Private recsToEdit As MapObjects2.Recordset
Private lnToEdit As MapObjects2.Line
Private symToEdit As MapObjects2.Symbol
Private symVertices As MapObjects2.Symbol

Private Sub Form_Load()

'加载数据
Dim dc As New MapObjects2.DataConnection
Dim mlyr As New MapObjects2.MapLayer
dc.Database = App.Path
dc.Connect
Set mlyr.GeoDataset = dc.FindGeoDataset("lines")
mlyr.Symbol.Color = moBlue
Map1.Layers.Add mlyr

'放大一点
Dim rect As MapObjects2.Rectangle
Set rect = Map1.FullExtent
rect.ScaleRectangle 1.1
Set Map1.FullExtent = rect
Set Map1.Extent = rect

'符号
Set symVertices = New MapObjects2.Symbol
With symVertices
  .SymbolType = moPointSymbol
  .Style = moSquareMarker
  .Color = moGreen
  .Size = 5
End With
Set symToEdit = New MapObjects2.Symbol
With symToEdit
  .SymbolType = moLineSymbol
  .Style = moSolidLine
  .Color = moGreen
  .Size = 2
End With

End Sub

Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)

Dim i As Long, j As Long
Dim recs As MapObjects2.Recordset
Dim ln As MapObjects2.Line
  
' 绘制选择的line.  能移动或者分割
If Not lnToEdit Is Nothing Then
  Map1.DrawShape lnToEdit, symToEdit
End If
Option2.Enabled = Not lnToEdit Is Nothing
Option3.Enabled = Not lnToEdit Is Nothing

'绘制所有点的节点
Set recs = Map1.Layers(0).Records
Do Until recs.EOF
  Set ln = recs.Fields("Shape").Value
  For i = 0 To ln.Parts.Count - 1
    For j = 0 To ln.Parts(i).Count - 1
      '端点红色.  中间节点green
      symVertices.Color = IIf(((j = 0) Or (j = ln.Parts(i).Count - 1)), moRed, moGreen)
      Map1.DrawShape ln.Parts(i)(j), symVertices
    Next j
  Next i
  recs.MoveNext
Loop

End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim recsLayer As MapObjects2.Recordset
Dim pt As MapObjects2.Point
Dim i As Long
Dim tol As Double
Dim dThisDist As Double, dShortDist As Double
Dim iShortVert As Long
Dim ptNewVert As MapObjects2.Point
Dim lnNew1 As MapObjects2.Line
Dim lnNew2 As MapObjects2.Line
Dim ptsNew As MapObjects2.Points

'便于选中,点鼠标选择范围加大
Set pt = Map1.ToMapPoint(X, Y)
tol = Map1.ToMapDistance(5 * Screen.TwipsPerPixelX)

Select Case True

  Case Option1  '选中线编辑
    Set recsToEdit = Map1.Layers(0).SearchByDistance(pt, tol, "")
    If Not recsToEdit.EOF Then
      Set lnToEdit = recsToEdit.Fields("Shape").Value
     Else
      Set lnToEdit = Nothing
    End If
    
  Case Option2  '分割线
    'As written, this routine only works with single part lines.
    If lnToEdit.Parts.Count > 1 Then
      MsgBox "This routine is not written to support multipart lines."
      Exit Sub
    End If
    
    'Find the closest segment to the mouse click
    dShortDist = 999999999
    For i = 0 To lnToEdit.Parts(0).Count - 2
      dThisDist = pt.DistanceToSegment(lnToEdit.Parts(0)(i), lnToEdit.Parts(0)(i + 1))
      If dThisDist < dShortDist Then
        dShortDist = dThisDist
        iShortVert = i
      End If
    Next i
    
    'If mouse click is further than 5 pixels from the edit line, bail out.
    If dShortDist > tol Then
      MsgBox "Click was not close enough to the edit line."
      Exit Sub
    End If
    
    'Make a new vertex for where the line is to be split.
    lnToEdit.SetMeasuresAsLength
    Set ptNewVert = lnToEdit.ReturnPointEvents(lnToEdit.ReturnMeasure(pt)).Item(0)
    
    'Make first new line
    Set ptsNew = New MapObjects2.Points
    Set lnNew1 = New MapObjects2.Line
    For i = 0 To iShortVert
      ptsNew.Add lnToEdit.Parts(0)(i)
    Next i
    ptsNew.Add ptNewVert
    lnNew1.Parts.Add ptsNew
    
    'Make second new line
    Set ptsNew = New MapObjects2.Points
    Set lnNew2 = New MapObjects2.Line
    ptsNew.Add ptNewVert
    For i = (iShortVert + 1) To (lnToEdit.Parts(0).Count - 1)
      ptsNew.Add lnToEdit.Parts(0)(i)
    Next i
    lnNew2.Parts.Add ptsNew
    
    'Delete the original line
    recsToEdit.Delete
    recsToEdit.StopEditing
    Set recsToEdit = Nothing
    
    'Add the two new lines
    Set recsLayer = Map1.Layers(0).Records
    recsLayer.AddNew
    Set recsLayer.Fields("Shape").Value = lnNew1
    recsLayer.Update
    recsLayer.AddNew
    Set recsLayer.Fields("Shape").Value = lnNew2
    recsLayer.Update
    recsLayer.StopEditing
    
    Set lnToEdit = Nothing
    Option1.Value = True
    Option2.Enabled = False
    Option3.Enabled = False
    
  Case Option3  'CLICK ON THE MAP TO MOVE THE SELECTED LINE
    lnToEdit.Offset pt.X - lnToEdit.Extent.Center.X, pt.Y - lnToEdit.Extent.Center.Y
    recsToEdit.Edit
    Set recsToEdit.Fields("Shape").Value = lnToEdit
    recsToEdit.Update
    recsToEdit.StopEditing
    
End Select

Map1.Refresh
    
End Sub
举报 回复(0) 喜欢(0)     评分
总有黎明
路人甲
路人甲
  • 注册日期2003-09-25
  • 发帖数59
  • QQ
  • 铜币276枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2003-09-28 15:31
十分感谢,没想到您那么快就回复了,不知道您对在.net中的AO开发熟悉吗?能提供一些事例吗!
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15946
  • QQ554730525
  • 铜币25338枚
  • 威望15363点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
3楼#
发布于:2003-09-28 16:24
我最近在用vb做acrmap的开发。有空多交流
举报 回复(0) 喜欢(0)     评分
游客

返回顶部