[VBA]

pmq

[VBA]如何利用vba提取polyline中各顶点的坐标?亿万分感谢!
下面这段程序只能获得坐标，只能获得第一个点的高程，无法获得每个点的高程。 Sub RevPline()
Dim ent As AcadEntity
Dim pnt As Variant
Dim NewCoord() As Double
Dim i As Integer
On Error Resume Next
Do
ThisDrawing.Utility.GetEntity ent, pnt, "选择多段线："
If Err Then Exit Sub
If TypeName(ent) Like "IAcad*Polyline" Then Exit Do
Loop
Dim Coord As Variant
Dim CoordCount As Integer
Dim Bulge() As Double '凸度
If TypeName(ent) = "IAcadLWPolyline" Then
Coord = ent.Coordinates '获取顶点坐标数组
CoordCount = (UBound(Coord) + 1) / 2 '顶点数
'定义新的顶点坐标数组
ReDim NewCoord(UBound(Coord)) As Double
For i = 0 To UBound(Coord) - 1 Step 2
NewCoord(UBound(Coord) - i - 1) = Coord(i)
NewCoord(UBound(Coord) - i) = Coord(i + 1)
Next
ReDim Bulge(CoordCount - 1) As Double
For i = 0 To CoordCount - 1
Bulge(i) = ent.GetBulge(i)
Next
ent.Coordinates = NewCoord
For i = 0 To CoordCount - 2
ent.SetBulge i, -Bulge(CoordCount - 2 - i)
Next
ThisDrawing.Regen acActiveViewport
ElseIf TypeName(ent) = "IAcadPolyline" Then
Coord = ent.Coordinates
CoordCount = (UBound(Coord) + 1) / 3
ReDim NewCoord(UBound(Coord)) As Double
For i = 0 To UBound(Coord) - 1 Step 3
NewCoord(UBound(Coord) - i - 2) = Coord(i)
NewCoord(UBound(Coord) - i - 1) = Coord(i + 1)
NewCoord(UBound(Coord) - i) = Coord(i + 2)
Next
If ent.Type = acSimplePoly Then
ReDim Bulge(CoordCount - 1) As Double
For i = 0 To CoordCount - 1
Bulge(i) = ent.GetBulge(i)
Next
End If
ent.Coordinates = NewCoord
If ent.Type = acSimplePoly Then
For i = 0 To CoordCount - 2
ent.SetBulge i, -Bulge(CoordCount - 2 - i)
Next
End If
ThisDrawing.Regen acActiveViewport
End If

End Sub

小美菜

这东些最好把多段线的点位坐标转成坐标结构数组（可以三、二维），算法简单

莫名

二维多段线、轻便多段线每个顶点的高程（Z值）相同，若要每个顶点的高程不一样，则要用三维多段线（这才是真三维的）

pmq

谢谢版主


但怎样绘制三维多线段，我是刚学用VBA编程的人。


------------------------------------


笨鸟先问