Private Sub ReversePline(plineObj As AcadEntity)
Dim pts() As Double
Dim bulge() As Double
Dim legs As Integer
Dim retcoord As Variant
Dim i As Integer
Dim i2 As Integer
Dim FN As Long
'--- I added some code to write bulges to a text file so I can see what its doing ---
FN = FreeFile
Open "C:\bulge.txt" For Output As #FN
retcoord = plineObj.Coordinates
ReDim Preserve pts(UBound(retcoord))
legs = (UBound(retcoord) / 2) - 1
ReDim Preserve bulge(legs)
For i = legs To 0 Step -1
Print #FN, i & " = " & CStr(plineObj.GetBulge(legs - i))
bulge(i) = plineObj.GetBulge(legs - i) * -1
Next i
For i = UBound(retcoord) To 0 Step -2
i2 = UBound(retcoord) - i
pts(i2 + 1) = retcoord(i)
pts(i2) = retcoord(i - 1)
Next i
plineObj.Coordinates = pts
For i = 0 To legs
plineObj.SetBulge i, bulge(i)
Print #FN, i & " = " & CStr(plineObj.GetBulge(legs - i))
Next i
Close #FN
End Sub
Private Sub ReversePline(plineObj As AcadEntity)
Dim pts() As Double
Dim OLDptX() As Double
Dim OLDptY() As Double
Dim NEWptX() As Double
Dim NEWptY() As Double
Dim bulge() As Double
Dim legs As Integer
Dim retcoord As Variant
Dim i As Integer
Dim iOLD As Integer
Dim iNEW As Integer
retcoord = plineObj.Coordinates
ReDim Preserve pts(UBound(retcoord))
legs = ((UBound(retcoord) + 1) / 2) - 1
ReDim Preserve OLDptX(legs)
ReDim Preserve OLDptY(legs)
ReDim Preserve NEWptX(legs)
ReDim Preserve NEWptY(legs)
ReDim Preserve bulge(legs)
'\\\Establish Points Array from PolyLine Coords
For i = 0 To UBound(retcoord)
pts(i) = retcoord(i)
Next i
'\\\Keep PointZero the same and Reverse Remaining Points
'\\\Brute Force Method (Ugh *scratch scratch*)
iNEW = legs
For iOLD = 1 To legs
OLDptX(iOLD) = pts(iOLD * 2)
OLDptY(iOLD) = pts((iOLD * 2) + 1)
NEWptX(iNEW) = OLDptX(iOLD)
NEWptY(iNEW) = OLDptY(iOLD)
iNEW = iNEW - 1
Next iOLD
'\\\NOTE-New Points Gathered, but Not Applied Yet
'\\\Get Bulges in Reverse Order and Make Them Negative
For i = 0 To legs
bulge(i) = plineObj.GetBulge(legs - i) * -1
Next i
'\\\Reverse All Points Except PointZero (Apply New Points)
For i = 1 To legs
pts(i * 2) = NEWptX(i)
pts((i * 2) + 1) = NEWptY(i)
Next i
'\\\Give New Points to PolyLine
plineObj.Coordinates = pts
'\\\Set New Bulges
For i = 0 To legs
plineObj.SetBulge i, bulge(i)
Next i
plineObj.Update
End Sub
style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">
<StevieLee> wrote in messageEureka!
href="news:6052776@discussion.autodesk.com">news:6052776@discussion.autodesk.com...
(eeka...eeka) I figgered it out.
I went back and applied a little brute
force tactics, making OLDX and OLDY then swapping NEWX and NEWY, etc. Not very
elegant, but "Life is pain. Get used to it." (Name that movie.)
Anyway,
it worked, and I'll post it below for anyone who's interested.
snip
Public Sub ReversePolyline()
Dim NewCoords() As Double
Dim Bulge() As Double
Dim Segm() As Double
Dim Bul As Double
Dim OldCoords As Variant
Dim Entity As AcadEntity
Dim legs As Integer
Dim I As Integer
Dim J As Integer
Dim N As Integer
OldCoords = plineObj.Coordinates
ReDim NewCoords(LBound(OldCoords) To UBound(OldCoords)) As Double
J = LBound(NewCoords)
For I = UBound(OldCoords) To LBound(OldCoords) + 1 Step -2
NewCoords(J) = OldCoords(I - 1)
NewCoords(J + 1) = OldCoords(I)
J = J + 2
Next I
N = 0
For I = LBound(OldCoords) To UBound(OldCoords) - 2 Step 2
Bul = plineObj.GetBulge(I / 2)
N = N + 1
ReDim Preserve Bulge(N)
ReDim Preserve Segm(N)
Bulge(N) = Bul * -1
Segm(N - 1) = (I / 2)
Next I
Segm(N) = N
For I = LBound(OldCoords) To UBound(OldCoords) - 2 Step 2
plineObj.SetBulge Segm(I / 2), 0
Next I
For I = 0 To N - 1
plineObj.SetBulge Segm(I + 1) - 1, Bulge(N - I)
Next I
plineObj.SetBulge Segm(N), Bulge(1)
plineObj.Coordinates = NewCoords
plineObj.Update
End Sub
Can't find what you're looking for? Ask the community or share your knowledge.