[VBA]如何利用vba提取polyline中各顶点的坐标?亿万分感谢!

h_lon

[VBA]如何利用vba提取polyline中各顶点的坐标?

bluemoon

coordinate属性

myfreemind

h_lon发表于2003-12-15 18:52:00如何利用vba提取polyline中各顶点的坐标?亿万分感谢!
如何利用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

h_lon

谢谢诸位大侠!