怎样提取三维多段线顶点坐标

pmq

    Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.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

sieben

三维多段线会不会只有控制点，没有顶点？

guohq

  For Each ID As ObjectId In Polyline3d
                Dim Vertex As PolylineVertex3d = Trans.GetObject(ID, OpenMode.ForRead)

Next

pmq

guohq 发表于 2018-12-12 22:36
For Each ID As ObjectId In Polyline3d
                Dim Vertex As PolylineVertex3d = Trans.GetO ...

ListBox1.Items.Add("X" & JS & "=" &
怎样显示各顶点的坐标
VB6与VB.net相差太大

pmq

Dim basePnt As Object = 0
        SetFocus(Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Window.Handle) 'CAD获得焦点

        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)
        returnObj.highlight(True)
        AppActivate(AcadApp.Caption)
        ListBox1.Items.Clear()
        Dim InPoint As Object
        Dim i As Integer = 0
        Dim JS As Long = 0
        Dim j As Integer = 0
        Dim ji As Long = 0
        
        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(i).ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("Y" & i + 1 & "= " & xx(i).ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("H" & i + 1 & "= " & zz(i).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(i).ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("Y" & i + 1 & "= " & xx(i).ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("H" & i + 1 & "= " & zz(i).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


                    ListBox1.Items.Add("X" & i + 1 & "= " & yy(i).ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("Y" & i + 1 & "= " & xx(i).ToString("0.000") & vbCrLf)
                    ListBox1.Items.Add("H" & i + 1 & "= " & zz(i).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)

你有种再说一遍

https://www.cnblogs.com/JJBox/p/14423632.html
跟二维一样提取？

varwolf2017

通过多边形的直线，怎么求其与多边形的交点

varwolf2017

多段线的顶点可以直接GetPoint2dAt(index),GetPoint2dAt(index)