pmq 发表于 2018-12-7 11:17:00

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

Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click '提取坐标
      SetFocus(Autodesk..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 发表于 2018-12-11 14:08:00

三维多段线会不会只有控制点,没有顶点?

guohq 发表于 2018-12-12 22:36:00

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

pmq 发表于 2018-12-19 11:09:00


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

pmq 发表于 2021-5-13 10:19:00

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)

你有种再说一遍 发表于 2021-5-15 06:05:00

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

varwolf2017 发表于 2021-6-8 21:23:00

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

varwolf2017 发表于 2021-6-8 21:31:00

多段线的顶点可以直接GetPoint2dAt(index),GetPoint2dAt(index)
页: [1]
查看完整版本: 怎样提取三维多段线顶点坐标