怎样提取三维多段线顶点(控制点)坐标

pmq

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click '提取坐标
        SetFocus(Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Window.Handle) 'CAD获得焦点

        Dim db As Database = HostApplicationServices.WorkingDatabase
        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim enOpts As PromptEntityOptions = New PromptEntityOptions("选择一条多段线")
        Dim enRes As PromptEntityResult = ed.GetEntity(enOpts)

        If enRes.Status = PromptStatus.OK Then
            Using trans As Transaction = db.TransactionManager.StartTransaction()

                Dim en As Entity = CType(trans.GetObject(enRes.ObjectId, OpenMode.ForRead), Entity)
                If TypeOf en Is Polyline Then
                    Dim pl As Polyline = CType(en, Polyline)

                    Dim pts_len As Integer = pl.NumberOfVertices
                    Dim i As Integer
                    For i = 0 To pts_len - 1
                        Dim JS As Integer = 0
                        JS = i + 1
                        ListBox1.Items.Add("X" & JS & "=" & pl.GetPoint3dAt(i).X.ToString("0.000") & vbCrLf)
                        ListBox1.Items.Add("Y" & JS & "=" & pl.GetPoint3dAt(i).Y.ToString("0.000") & vbCrLf)
                        ListBox1.Items.Add("H" & JS & "=" & pl.GetPoint3dAt(i).Z.ToString("0.000") & vbCrLf)
                        'ed.WriteMessage(pl.GetPoint3dAt(i).ToString() + "\n")
                    Next
                ElseIf TypeOf en Is Polyline3d Then
                    '三维多段线
                    ？？？
                ElseIf TypeOf en Is Line Then
                    Dim pl As Line = CType(en, Line)

                    ListBox1.Items.Add("XA=" & pl.StartPoint.X.ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("YA=" & pl.StartPoint.Y.ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("HA=" & pl.StartPoint.Z.ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("XB=" & pl.EndPoint.X.ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("YB=" & pl.EndPoint.Y.ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("HB=" & pl.EndPoint.Z.ToString("0.000") & vbCrLf)
                Else
                    ed.WriteMessage("你选择的是" + en.GetRXClass().Name)
                End If
                trans.Commit()
            End Using
        End If

dnbcgrass

Dim pl3d As Polyline3d = TryCast(obj, Polyline3d)
For Each id As ObjectId In pl3d
    Dim ver As PolylineVertex3d = DirectCast(tr.GetObject(id, OpenMode.ForRead), PolylineVertex3d)
    ListBox1.Items.Add("X=" & ver.Position.X.ToString("0.000") & vbCrLf)
    ListBox1.Items.Add("Y=" & ver.Position.Y.ToString("0.000") & vbCrLf)
    ListBox1.Items.Add("H=" & ver.Position.Z.ToString("0.000") & vbCrLf)
Next

xk15c

谢谢分享学习经验。

pmq

AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)
        returnObj.highlight(True)
        AppActivate(AcadApp.Caption)
        ListBox1.Items.Clear()
      
        Select Case returnObj.objectname
            Case "AcDb3dPolyline"

                ObjName.Text = "三维多段线"
                JS = (UBound(returnObj.Coordinates) + 1) / 3 - 1
                ReDim Preserve xx(JS)
                ReDim Preserve yy(JS)
                ReDim Preserve zz(JS)
                For i = 0 To JS

                    xx(i) = returnObj.Coordinate(i)(0)
                    yy(i) = returnObj.Coordinate(i)(1)
                    zz(i) = returnObj.Coordinate(i)(2)
                    
                    ListBox1.Items.Add("X" & i + 1 & "= " & yy(j).ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("Y" & i + 1 & "= " & xx(j).ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("H" & i + 1 & "= " & zz(j).ToString("0.000") & vbCrLf)
                Next
            Case "AcDb2dPolyline"

                ObjName.Text = "二维多段线"
                JS = (UBound(returnObj.Coordinates) + 1) / 2 - 1
                ReDim Preserve xx(JS)
                ReDim Preserve yy(JS)
                ReDim Preserve zz(JS)
                For i = 0 To JS

                    xx(i) = returnObj.Coordinate(i)(0)
                    yy(i) = returnObj.Coordinate(i)(1)
                    zz(i) = returnObj.elevation
                  
                    ListBox1.Items.Add("X" & i + 1 & "= " & yy(j).ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("Y" & i + 1 & "= " & xx(j).ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("H" & i + 1 & "= " & zz(j).ToString("0.000") & vbCrLf)
                Next
            Case "AcDbPolyline"

                ObjName.Text = "多段线"
                JS = (UBound(returnObj.Coordinates) + 1) / 2 - 1
                ReDim Preserve xx(JS)
                ReDim Preserve yy(JS)
                ReDim Preserve zz(JS)
                For i = 0 To JS

                    xx(i) = returnObj.Coordinate(i)(0)
                    yy(i) = returnObj.Coordinate(i)(1)
                    zz(i) = returnObj.elevation
                  
                    ji = ji + 1
                    ListBox1.Items.Add("X" & i + 1 & "= " & yy(j).ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("Y" & i + 1 & "= " & xx(j).ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("H" & i + 1 & "= " & zz(j).ToString("0.000") & vbCrLf)
                Next
            Case "AcDbLine"

                ObjName.Text = "直线"
                Dim StartPoints As Object
                Dim EndPoints As Object
                ReDim Preserve xx(1)
                ReDim Preserve yy(1)
                ReDim Preserve zz(1)
                StartPoints = returnObj.StartPoint
                EndPoints = returnObj.EndPoint
                xx(0) = StartPoints(0)
                yy(0) = StartPoints(1)
                zz(0) = StartPoints(2)
                xx(1) = EndPoints(0)
                yy(1) = EndPoints(1)
                zz(1) = EndPoints(2)
                ListBox1.Items.Add("X" & 1 & "= " & yy(0).ToString("0.000") & vbCrLf)
                ListBox1.Items.Add("Y" & 1 & "= " & xx(0).ToString("0.000") & vbCrLf)
                ListBox1.Items.Add("H" & 1 & "= " & zz(0).ToString("0.000") & vbCrLf)
                ListBox1.Items.Add("X" & 2 & "= " & yy(1).ToString("0.000") & vbCrLf)
                ListBox1.Items.Add("Y" & 2 & "= " & xx(1).ToString("0.000") & vbCrLf)
                ListBox1.Items.Add("H" & 2 & "= " & zz(1).ToString("0.000") & vbCrLf)
            Case "AcDbSpline"

                ObjName.Text = "样条曲线"

wxn80

楼主找到批量提取三维多段线的节点坐标和高程的方法了吗？你写的代码是LSP文件吗？