怎样提取三维多段线顶点坐标
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
三维多段线会不会只有控制点，没有顶点？ For Each ID As ObjectId In Polyline3d
Dim Vertex As PolylineVertex3d = Trans.GetObject(ID, OpenMode.ForRead)
Next 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相差太大 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
跟二维一样提取？ 通过多边形的直线，怎么求其与多边形的交点 多段线的顶点可以直接GetPoint2dAt(index),GetPoint2dAt(index)
页:
[1]