Visual Basic Customization

[#1]

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.

[#2]

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

[#3]

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

[#4]

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

<StevieLee> wrote in message
href="news:6052776@discussion.autodesk.com">news:6052776@discussion.autodesk.com...

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

[#5]

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