pmq 发表于 2004-8-10 17:15:00

[VBA]

如何利用vba提取polyline中各顶点的坐标?亿万分感谢!<BR>


下面这段程序只能获得坐标，只能获得第一个点的高程，无法获得每个点的高程。


Sub        RevPline()<BR>                                Dim        ent        As        AcadEntity<BR>                                Dim        pnt        As        Variant<BR>                                Dim        NewCoord()        As        Double<BR>                                Dim        i        As        Integer<BR>                                On        Error        Resume        Next<BR>                                Do<BR>                                                                ThisDrawing.Utility.GetEntity        ent,        pnt,        "选择多段线："<BR>                                                                If        Err        Then        Exit        Sub<BR>                                                                If        TypeName(ent)        Like        "IAcad*Polyline"        Then        Exit        Do<BR>                                Loop<BR>                                Dim        Coord        As        Variant<BR>                                Dim        CoordCount        As        Integer<BR>                                Dim        Bulge()        As        Double        '凸度<BR>                                If        TypeName(ent)        =        "IAcadLWPolyline"        Then<BR>                                                                Coord        =        ent.Coordinates        '获取顶点坐标数组<BR>                                                                CoordCount        =        (UBound(Coord)        +        1)        /        2        '顶点数<BR>                                                                '定义新的顶点坐标数组<BR>                                                                ReDim        NewCoord(UBound(Coord))        As        Double<BR>                                                                For        i        =        0        To        UBound(Coord)        -        1        Step        2<BR>                                                                                                NewCoord(UBound(Coord)        -        i        -        1)        =        Coord(i)<BR>                                                                                                NewCoord(UBound(Coord)        -        i)        =        Coord(i        +        1)<BR>                                                                Next<BR>                                                                ReDim        Bulge(CoordCount        -        1)        As        Double<BR>                                                                For        i        =        0        To        CoordCount        -        1<BR>                                                                                                Bulge(i)        =        ent.GetBulge(i)<BR>                                                                Next<BR>                                                                ent.Coordinates        =        NewCoord<BR>                                                                For        i        =        0        To        CoordCount        -        2<BR>                                                                                                ent.SetBulge        i,        -Bulge(CoordCount        -        2        -        i)<BR>                                                                Next<BR>                                                                ThisDrawing.Regen        acActiveViewport<BR>                                ElseIf        TypeName(ent)        =        "IAcadPolyline"        Then<BR>                                                                Coord        =        ent.Coordinates<BR>                                                                CoordCount        =        (UBound(Coord)        +        1)        /        3<BR>                                                                ReDim        NewCoord(UBound(Coord))        As        Double<BR>                                                                For        i        =        0        To        UBound(Coord)        -        1        Step        3<BR>                                                                                                NewCoord(UBound(Coord)        -        i        -        2)        =        Coord(i)<BR>                                                                                                NewCoord(UBound(Coord)        -        i        -        1)        =        Coord(i        +        1)<BR>                                                                                                NewCoord(UBound(Coord)        -        i)        =        Coord(i        +        2)<BR>                                                                Next<BR>                                                                If        ent.Type        =        acSimplePoly        Then<BR>                                                                                                ReDim        Bulge(CoordCount        -        1)        As        Double<BR>                                                                                                For        i        =        0        To        CoordCount        -        1<BR>                                                                                                                                Bulge(i)        =        ent.GetBulge(i)<BR>                                                                                                Next<BR>                                                                End        If<BR>                                                                ent.Coordinates        =        NewCoord<BR>                                                                If        ent.Type        =        acSimplePoly        Then<BR>                                                                                                For        i        =        0        To        CoordCount        -        2<BR>                                                                                                                                ent.SetBulge        i,        -Bulge(CoordCount        -        2        -        i)<BR>                                                                                                Next<BR>                                                                End        If<BR>                                                        ThisDrawing.Regen        acActiveViewport<BR>                                End        If<BR>                                <BR>End        Sub<BR>

小美菜 发表于 2004-8-10 21:03:00

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

莫名 发表于 2004-8-10 21:33:00

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

pmq 发表于 2004-8-11 13:00:00

谢谢版主


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


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


笨鸟先问
页: [1]
查看完整版本: [VBA]