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

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)