阅读:2200回复:3
请教如何在mo中分割一条线段?十分感谢
看到ao中提供split方法,请问在mo中如何实现
|
|
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 |
|
|
2楼#
发布于:2003-09-28 15:31
十分感谢,没想到您那么快就回复了,不知道您对在.net中的AO开发熟悉吗?能提供一些事例吗!
|
|
3楼#
发布于:2003-09-28 16:24
我最近在用vb做acrmap的开发。有空多交流
|
|
|