[原创]反转多段线

mccad

多段线有起始端和终止端，以下程序是将起始端和终止端对调过来，而在多段线的外观上没有变化。

2. Sub RevPline()
   
3.     Dim ent As AcadEntity
   
4.     Dim pnt As Variant
   
5.     Dim NewCoord() As Double
   
6.     Dim i As Integer
   
7.     On Error Resume Next
   
8.     Do
   
9.         ThisDrawing.Utility.GetEntity ent, pnt, "选择多段线："
   
10.         If Err Then Exit Sub
    
11.         If TypeName(ent) Like "IAcad*Polyline" Then Exit Do
    
12.     Loop
    
13.     Dim Coord As Variant
    
14.     If TypeName(ent) = "IAcadLWPolyline" Then
    
15.         Coord = ent.Coordinates
    
16.         ReDim NewCoord(UBound(Coord)) As Double
    
17.         For i = 0 To UBound(Coord) - 1 Step 2
    
18.             NewCoord(UBound(Coord) - i - 1) = Coord(i)
    
19.             NewCoord(UBound(Coord) - i) = Coord(i + 1)
    
20.         Next
    
21.         ent.Coordinates = NewCoord
    
22.         ThisDrawing.Regen acActiveViewport
    
23.     ElseIf TypeName(ent) = "IAcadPolyline" Then
    
24.         Coord = ent.Coordinates
    
25.         ReDim NewCoord(UBound(Coord)) As Double
    
26.         For i = 0 To UBound(Coord) - 1 Step 3
    
27.             NewCoord(UBound(Coord) - i - 2) = Coord(i)
    
28.             NewCoord(UBound(Coord) - i - 1) = Coord(i + 1)
    
29.             NewCoord(UBound(Coord) - i) = Coord(i + 2)
    
30.         Next
    
31.         ent.Coordinates = NewCoord
    
32.         ThisDrawing.Regen acActiveViewport
    
33.     End If
    
34.    
    
35. End Sub

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 />     If TypeName(ent) = "IAcadLWPolyline" Then<br />         Coord = ent.Coordinates<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 />         ent.Coordinates = NewCoord<br />         ThisDrawing.Regen acActiveViewport<br />     ElseIf TypeName(ent) = "IAcadPolyline" Then<br />         Coord = ent.Coordinates<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 />         ent.Coordinates = NewCoord<br />         ThisDrawing.Regen acActiveViewport<br />     End If<br />     <br /> End Sub

myfreemind

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

mccad

好，那就增加凸度的处理：

2. Sub RevPline()
   
3.     Dim ent As AcadEntity
   
4.     Dim pnt As Variant
   
5.     Dim NewCoord() As Double
   
6.     Dim i As Integer
   
7.     On Error Resume Next
   
8.     Do
   
9.         ThisDrawing.Utility.GetEntity ent, pnt, "选择多段线："
   
10.         If Err Then Exit Sub
    
11.         If TypeName(ent) Like "IAcad*Polyline" Then Exit Do
    
12.     Loop
    
13.     Dim Coord As Variant
    
14.     Dim CoordCount As Integer
    
15.     Dim Bulge() As Double
    
16.     If TypeName(ent) = "IAcadLWPolyline" Then
    
17.         Coord = ent.Coordinates
    
18.         CoordCount = (UBound(Coord) + 1) / 2
    
19.         ReDim NewCoord(UBound(Coord)) As Double
    
20.         For i = 0 To UBound(Coord) - 1 Step 2
    
21.             NewCoord(UBound(Coord) - i - 1) = Coord(i)
    
22.             NewCoord(UBound(Coord) - i) = Coord(i + 1)
    
23.         Next
    
24.         ReDim Bulge(CoordCount - 1) As Double
    
25.         For i = 0 To CoordCount - 1
    
26.             Bulge(i) = ent.GetBulge(i)
    
27.         Next
    
28.         ent.Coordinates = NewCoord
    
29.         For i = 0 To CoordCount - 2
    
30.             ent.SetBulge i, -Bulge(CoordCount - 2 - i)
    
31.         Next
    
32.         ThisDrawing.Regen acActiveViewport
    
33.     ElseIf TypeName(ent) = "IAcadPolyline" Then
    
34.         Coord = ent.Coordinates
    
35.         CoordCount = (UBound(Coord) + 1) / 3
    
36.         ReDim NewCoord(UBound(Coord)) As Double
    
37.         For i = 0 To UBound(Coord) - 1 Step 3
    
38.             NewCoord(UBound(Coord) - i - 2) = Coord(i)
    
39.             NewCoord(UBound(Coord) - i - 1) = Coord(i + 1)
    
40.             NewCoord(UBound(Coord) - i) = Coord(i + 2)
    
41.         Next
    
42.         If ent.Type = acSimplePoly Then
    
43.             ReDim Bulge(CoordCount - 1) As Double
    
44.             For i = 0 To CoordCount - 1
    
45.                 Bulge(i) = ent.GetBulge(i)
    
46.             Next
    
47.         End If
    
48.         ent.Coordinates = NewCoord
    
49.         If ent.Type = acSimplePoly Then
    
50.             For i = 0 To CoordCount - 2
    
51.                 ent.SetBulge i, -Bulge(CoordCount - 2 - i)
    
52.             Next
    
53.         End If
    
54.        ThisDrawing.Regen acActiveViewport
    
55.     End If
    
56.    
    
57. End Sub

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 />         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

myfreemind

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

wyj7485

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

wmz

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

askthesun

不能查看呢???

zzyong00

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

bshkl

好贴bc标记

玉麒麟卢比奥

NICE！谢楼主

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