VBA
Discuss AutoCAD ActiveX and VBA (Visual Basic for Applications) questions here.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Reverse Polyline - With Bulges - Last Bulge Problem

4 REPLIES 4
Reply
Message 1 of 5
StevieLee
850 Views, 4 Replies

Reverse Polyline - With Bulges - Last Bulge Problem

Ok, I'm writing a VBA to reverse the direction of a closed polyline, with bulges. I've pulled code from this forum (Thank yall very much) and it seems to be working except where the last point joins the first. If there is a bulge between the last point and the first point, it doesn't seem to register, and when the reversal is finished, the last bulge is reversed.

Is there a trick to getting and/or setting the bulge between the last and first points of a closed polyline? If I get the bulge from the last point, it says Zero, even though it's rounded.

I'm at the end of my day here, so I can't post code right now, but I'll toss it in here tomorrow.

Thanks.
4 REPLIES 4
Message 2 of 5
StevieLee
in reply to: StevieLee

Uh oh, no responses yet. Hope someone can help me figure this out.

As an example, draw a rectangle using RECTANG, then use FILLET to round off the corners. That'll be the GuineaPig. Here's the code I got from this forum. I forgot the name, but thank you very much.


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

Message 3 of 5
StevieLee
in reply to: StevieLee

Eureka! (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.


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

Message 4 of 5
Anonymous
in reply to: StevieLee


another option

just changed your indexes slightly

seems to work

 

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

'changed legs calc

legs = ((UBound(retcoord) + 1) / 2)

ReDim Preserve bulge(legs)

 

'changed index

For i = legs To 1 Step -1
'Print #FN, i & " = " &
CStr(plineObj.GetBulge(legs - i))
Print #FN, i & " = " &
CStr(plineObj.GetBulge(i - 1))
'bulge(i) = plineObj.GetBulge(legs - i) *
-1
bulge(i - 1) = plineObj.GetBulge(i - 1) * -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

 

'changed index

For i = 0 To legs - 1
plineObj.SetBulge i, bulge(i)
Print #FN, i
& " = " & CStr(plineObj.GetBulge(i))
Next i
Close #FN
End
Sub

 

hth

mark


style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">
Eureka!
(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

Message 5 of 5
suphit
in reply to: StevieLee

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.

Post to forums  

Autodesk Design & Make Report

”Boost