反向滑索
我从Malcom Fernandez那里得到了这些。他是一个很大的帮助，喜欢分享。一个用于打开，一个用于关闭。
Private Sub reverse_pline(polyEnt As AcadLWPolyline)
'this does a closed polyline
Dim idx As Integer
Dim numPts As Integer
Dim numBulge As Integer
Dim bulge As Double
'set an array to store the coordinates of the pline
Dim newcoord() As Double
numPts = UBound(polyEnt.Coordinates) - 1 'was -1
ReDim newcoord(numPts + 1) 'was 1
'set an array to store the bludge factor for each segment
Dim newbulge() As Double
numBulge = (((numPts)) / 2)'was -3)/2
ReDim newbulge(numBulge)
'loop through the vertices of the pline and save x,y in reverse order
For idx = 0 To numPts Step 2
newcoord(numPts - idx) = polyEnt.Coordinates(idx)
newcoord(numPts - idx + 1) = polyEnt.Coordinates(idx + 1) 'was +1 in 2 places
Next idx
'loop through the bulge factors and save in reverse order
For idx = 0 To numBulge
If idxnumBulge Then
newbulge(numBulge - idx) = polyEnt.GetBulge(idx) * -1
Else
newbulge(0) = polyEnt.GetBulge(idx) * -1
End If
Next idx
'reverse the original pline
polyEnt.Coordinates = newcoord
For idx = 0 To numBulge
If idx = 0 Then
polyEnt.SetBulge (numBulge), newbulge(idx)
Else
polyEnt.SetBulge (idx - 1), newbulge(idx)
End If
Next idx
polyEnt.Update
End Sub
Private Sub revPline(polyEnt As AcadLWPolyline)
'this does an open polyline
Dim idx As Integer
Dim numPts As Integer
Dim numBulge As Integer
Dim bulge As Double
'set an array to store the coordinates of the pline
Dim newcoord() As Double
numPts = UBound(polyEnt.Coordinates) - 1
ReDim newcoord(numPts + 1)
'set an array to store the bludge factor for each segment
Dim newbulge() As Double
numBulge = ((numPts - 3) / 2)
If ((UBound(polyEnt.Coordinates) + 1) / 2) Mod 2 = 0 Then
GoTo myout
Else
numBulge = numBulge + 1
End If
myout:
ReDim newbulge(numBulge)
'loop through the vertices of the pline and save x,y in reverse order
For idx = 0 To numPts Step 2
newcoord(numPts - idx) = polyEnt.Coordinates(idx)
newcoord(numPts - idx + 1) = polyEnt.Coordinates(idx + 1)
Next idx
'loop through the bulge factors and save in reverse order
For idx = 0 To numBulge
newbulge(numBulge - idx) = polyEnt.GetBulge(idx) * -1
Next idx
'reverse the original pline
polyEnt.Coordinates = newcoord
For idx = 0 To numBulge
polyEnt.SetBulge idx, newbulge(idx)
Next idx
polyEnt.Update
End Sub
**** Hidden Message ***** 您的程序没有保持段的可变宽度…
在LISP上查看我的程序。
http://www.theswamp.org/index.php?topic=8878.msg114590#msg114590 无论如何，谢谢你，但我不读lisp。我不知道你在那里干什么
使用budge数组作为起点，在此处添加该属性不会有太多工作。
页:
[1]