Auto-suggest helps you quickly narrow down your search results by suggesting possible matches as you type.

Close

Visual Basic Customization

- Autodesk Community
- >
- AutoCAD Customization
- >
- Visual Basic Customization
- >
- Re: Reverse Polyline - With Bulges - Last Bulge Pr...

Topic Options

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic to the Top
- Bookmark
- Subscribe
- Printer Friendly Page

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

348 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.

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.

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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.

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

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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.

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

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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

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

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

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

'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

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

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

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements

Start with some of our most frequented solutions to get help installing your software.

Upgrading to a 2015 product? Make sure to check these out 1st!

- Privacy | Legal Notices & Trademarks | Report Noncompliance | Site map | © Copyright 2014 Autodesk Inc. All rights reserved

Except where otherwise noted, this work is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. Please see the Autodesk Creative Commons FAQ for more information.