Visual Basic Customization

Visual Basic Customization

Reply
Distinguished Contributor
StevieLee
Posts: 118
Registered: ‎09-25-2007
Message 1 of 5 (369 Views)

Reverse Polyline - With Bulges - Last Bulge Problem

369 Views, 4 Replies
10-15-2008 02:57 PM
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.
Distinguished Contributor
StevieLee
Posts: 118
Registered: ‎09-25-2007
Message 2 of 5 (369 Views)

Re: Reverse Polyline - With Bulges - Last Bulge Problem

10-16-2008 06:23 AM 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

Distinguished Contributor
StevieLee
Posts: 118
Registered: ‎09-25-2007
Message 3 of 5 (369 Views)

Re: Reverse Polyline - With Bulges - Last Bulge Problem

10-16-2008 08:23 AM 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

*MP
Message 4 of 5 (369 Views)

Re: Reverse Polyline - With Bulges - Last Bulge Problem

10-16-2008 08:58 AM 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

New Member
suphit
Posts: 1
Registered: ‎11-25-2008
Message 5 of 5 (228 Views)

Re: Reverse Polyline - With Bulges - Last Bulge Problem

02-01-2013 10:58 AM 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

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.