社区 › VBA/VB/ActiveX/API 编程技术 › [原创]反转多段线

mccad 发表于 2003-9-15 20:54:00

[原创]反转多段线

多段线有起始端和终止端，以下程序是将起始端和终止端对调过来，而在多段线的外观上没有变化。
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
    If TypeName(ent) = "IAcadLWPolyline" Then
      Coord = ent.Coordinates
      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
      ent.Coordinates = NewCoord
      ThisDrawing.Regen acActiveViewport
    ElseIf TypeName(ent) = "IAcadPolyline" Then
      Coord = ent.Coordinates
      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
      ent.Coordinates = NewCoord
      ThisDrawing.Regen acActiveViewport
    End If
   
End Sub

myfreemind 发表于 2003-9-16 18:07:00

这个程序非常好用,如果再可以处理多段线中的圆弧就更好了!

mccad 发表于 2003-9-16 19:29:00

好，那就增加凸度的处理：
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

myfreemind 发表于 2003-9-18 01:37:00

太好用了!!MCCAD辛苦了!!

wyj7485 发表于 2004-9-23 11:57:00

那么我们怎么判断其方向是顺时针还是逆时针呢？

wmz 发表于 2004-9-23 14:21:00

在VLISP版块里有用VLISP写了一个"曲线反向"的程序.

askthesun 发表于 2009-11-28 16:34:00

<p>不能查看呢???</p>

zzyong00 发表于 2009-11-28 20:57:00

在这里留言，怎么经常出错，太郁闷了，刚打好的字儿，没了

bshkl 发表于 2014-5-3 23:11:27

好贴bc标记

玉麒麟卢比奥 发表于 2014-5-6 15:32:27

NICE！谢楼主

楼主大神，能提供一个多段线端点三维坐标的程序吗？给点提示也成！我比较小白。要是带Z坐标的哦

查看完整版本: [原创]反转多段线