### Author Topic: Offset a polyline  (Read 4211 times)

0 Members and 1 Guest are viewing this topic.

#### Troy Williams

• Guest ##### Offset a polyline
« on: September 27, 2005, 01:16:18 PM »
Does anyone have a code sample that offsets a polyline similar to the offset command in AutoCAD?

#### Draftek ##### Re: Offset a polyline
« Reply #1 on: September 27, 2005, 04:31:15 PM »
I kinda did that a few years ago using vba to take a polyline profile of one side of an extrusion to calculate some breakmetal bends. It is quite a lot of code. If you want to parse thru it to get what you want, I'll be glad to post.
« Last Edit: September 27, 2005, 04:35:37 PM by Draftek »
Soli Deo Gloria

#### Troy Williams

• Guest ##### Re: Offset a polyline
« Reply #2 on: September 27, 2005, 06:46:31 PM »
I kinda did that a few years ago using vba to take a polyline profile of one side of an extrusion to calculate some breakmetal bends. It is quite a lot of code. If you want to parse thru it to get what you want, I'll be glad to post.

Thanks for the offer, I appreciate it.

I have a good idea on what needs to be done but I can't seem to figure out the starting point. The way I see it is that a polyline can consist of hundreds of segments (I am only interested in straight segments, no fancy stuff like bulges) and can be opened or closed. The first step is to determine which side the offset is on (left, right, top, bottom, inside or outside). Each segment needs to be offset by a certain amount along a line that is perpendicular to the line segment. The perpendicular is the one that points in the correct offset direction (either positive or negative). Once I have the correct perpendicular line then I can easily create an offset of the line segment. Since all polylines are either clockwise or counter-clockwise I can pretty much use the first perpendicular as a reference to tell me wheather each of the segments use a positive or negative perpendicular offset. From there it is simply a matter of finding all the intersection points of the adjacent segments and constructing the offset entity.

I hope that made sense. I am having problems figuring out if the perpendicular offset should be negative or positive. I'd love to post a diagram, but I won't have access to a proper system till next week. ##### Re: Offset a polyline
« Reply #3 on: September 27, 2005, 07:01:32 PM »
Hi Troy,
I think you are looking too deep into this. Wouldn't be easier to just offset the pline instead of the individual segments? Plines are offset with a positive value being to the right, and negative to the left, in relation to the direction they were drawn. So that leaves just finding the side that is selected when the offset is a given distance, and finding the perpendicular distance at the specified point for a "Through" distance.

Does that make it any simpler?

#### Troy Williams

• Guest ##### Re: Offset a polyline
« Reply #4 on: September 28, 2005, 07:42:55 AM »
Hi Troy,
I think you are looking too deep into this. Wouldn't be easier to just offset the pline instead of the individual segments? Plines are offset with a positive value being to the right, and negative to the left, in relation to the direction they were drawn. So that leaves just finding the side that is selected when the offset is a given distance, and finding the perpendicular distance at the specified point for a "Through" distance.

Does that make it any simpler?

Jeff, that does make it simpler! I'll see if I can work out the math today. Thanks!

#### Draftek ##### Re: Offset a polyline
« Reply #5 on: September 28, 2005, 08:07:35 AM »
Well, if you can do that then this may be overkill but here it is anyway. There will be way more here than you are interested in and I'm sorry for bad coding techniques but this is a few years old. Of course you will not be interested in the buldges but I needed them to show the sheetmetal bends.

here is the form code:
Code: [Select]
`'frmMainOption Explicit' form scope variables' the offset (thickness of the shape)Private dOffset As Double' Insertion PointPrivate Ipt(0 To 2) As Double' Viewport scalePrivate ViewScale As Double' how many breaksPrivate Breaks As Integer' the blank lengthPrivate brkLength As Double' break calculation modifierPrivate dblModifier As DoublePrivate Sub Go()    Dim varCoords As Variant    Dim NewCoords() As Double    ' the three points necessary to build an angular dimension    Dim pt1(0 To 2) As Double    Dim pt2(0 To 2) As Double    Dim pt3(0 To 2) As Double    Dim varRet As Variant    Dim varStPt As Variant    Dim ObjEntity As AcadLWPolyline    Dim objNewEntity As AcadLWPolyline    Dim angle1 As Double    Dim angle2 As Double    Dim angle3 As Double    Dim Dir1 As Double    Dim Dir2 As Double    Dim DistTemp As Double    Dim Dist1 As Double    Dim Dist2 As Double    Dim Plus As Boolean    Dim aPlus As Boolean    Dim I As Integer    Dim J As Integer    Dim count As Integer    Dim NewCount As Integer    Dim currentY As Integer    Dim currentOppY As Integer    Dim ProjectExist As Boolean    Dim CurrSegCount As Integer    Dim CurrOppSegCount As Integer    Dim BulgeArray() As Integer    Dim AngleArray() As Double    Const x = 0    Const y = 1        ' get the ployline    Set ObjEntity = Get_Poly        ' if it's a closed polyline then it's going to look funky    If ObjEntity.Closed Then        MsgBox "This is a closed polyline, Hmmm..." & vbCr & _               "I REALLY Don't think you want to do that.. I quit"        End    End If        varCoords = ObjEntity.Coordinates    ' if there are less than 5 points then you can't    ' get an angle    If UBound(varCoords) < 5 Then ' inform and insult the user        MsgBox "This polyline has less than 2 sides you dork"        Exit Sub    End If    ' set the new coordinates boundaries    count = UBound(varCoords)    ReDim NewCoords(count * 3)    NewCount = UBound(NewCoords)    ' get the first vector of the polyline and the direction from point1 to point2    pt1(x) = varCoords(0): pt1(y) = varCoords(1)    pt2(x) = varCoords(2): pt2(y) = varCoords(3)    Dir1 = ThisDrawing.Utility.AngleFromXAxis(pt1, pt2)        ' get the middle point so we can get a direction    Dist1 = Distance(pt1, pt2)    varStPt = ThisDrawing.Utility.PolarPoint(pt1, Dir1, 0.5 * Dist1)    angle1 = ThisDrawing.Utility.GetAngle(varStPt, "Pick Side To Offset: ")        ' do we add 90 along the path or subtract 90 for the offset direction    Plus = isPlus(Dir1, angle1)        ' and the array of the buldges    ReDim BulgeArray(CInt((count - 3) / 2) - 1)    ReDim AngleArray(UBound(BulgeArray))    ' set the breaks to this number plus one    Breaks = UBound(BulgeArray) + 1    Dim TmpCount As Integer    ' calculate the total segment count    TmpCount = CInt((count - 1) / 2)    TmpCount = (TmpCount * 2) + TmpCount    'initialize the j counter and the segment counters    J = 0    CurrSegCount = 0    CurrOppSegCount = TmpCount    ' loop thru the points and process the polyline    For I = 5 To count Step 2        ' points 1 thru 3        pt1(x) = varCoords(I - 5): pt1(y) = varCoords(I - 4)        pt2(x) = varCoords(I - 3): pt2(y) = varCoords(I - 2)        pt3(x) = varCoords(I - 1): pt3(y) = varCoords(I)        ' get the distances        Dist1 = Distance(pt1, pt2)        Dist2 = Distance(pt2, pt3)        ' get the directions        Dir1 = ThisDrawing.Utility.AngleFromXAxis(pt2, pt1)        Dir2 = ThisDrawing.Utility.AngleFromXAxis(pt2, pt3)        ' set the small angle        angle1 = SmallAngle(Dir1, Dir2)        ' reverse the direction of the first vector to follow the polyline path        Dir1 = ThisDrawing.Utility.AngleFromXAxis(pt1, pt2)        ' set the angle perpendicular to the current vector        If Plus Then            angle2 = Dir1 + dtr(90)        Else            angle2 = Dir1 - dtr(90)        End If        ' is the current angle in the plus direction or not        aPlus = isPlus(Dir1, Dir2)        ' first we sould test to see whether this is the first angle        ' if it is then do the square corner stuff        If I = 5 Then ' first segment            ' set the first and last points of the new polyline            ' First Point            NewCoords(x) = varCoords(x): NewCoords(y) = varCoords(y)            ' last point            NewCoords(NewCount - 1) = varCoords(x): NewCoords(NewCount) = varCoords(y)            ' second to last point - move over the offset distance            varRet = ThisDrawing.Utility.PolarPoint(pt1, angle2, dOffset)            ' set the coordinates            NewCoords(NewCount - 3) = varRet(x): NewCoords(NewCount - 2) = varRet(y)            ' set the current y place and the opposite y place            currentY = 1            currentOppY = NewCount - 2            ' segment index for the buldge calculation            CurrSegCount = 1            CurrOppSegCount = CurrOppSegCount - 2        End If        ' do we project the bulge points on the existing line or the projected line        If Plus Then            If aPlus Then                ProjectExist = True            Else                ProjectExist = False            End If        Else            If aPlus Then                ProjectExist = False            Else                ProjectExist = True            End If        End If        ' now calculate offset distance        If angle1 = 0 Then angle1 = dtr(360)        DistTemp = (dOffset / (Tan(0.5 * angle1)))        If angle1 = dtr(360) Then angle1 = 0        If ProjectExist Then ' project the buldge on the existing line            ' go back dir1            varRet = ThisDrawing.Utility.PolarPoint(pt2, Dir1 - dtr(180), DistTemp)            NewCoords(currentY + 1) = varRet(x): NewCoords(currentY + 2) = varRet(y)            ' now set the opposite corner            varRet = ThisDrawing.Utility.PolarPoint(varRet, angle2, dOffset)            NewCoords(currentOppY - 3) = varRet(x): NewCoords(currentOppY - 2) = varRet(y)            ' now go up dir2            varRet = ThisDrawing.Utility.PolarPoint(pt2, Dir2, DistTemp)            NewCoords(currentY + 3) = varRet(x): NewCoords(currentY + 4) = varRet(y)            ' reset currenty and opposite y            currentY = currentY + 4            currentOppY = currentOppY - 2            ' set the buldge and move the counters            BulgeArray(J) = CurrSegCount            AngleArray(J) = Tan((dtr(180) - angle1) / 4)            CurrSegCount = CurrSegCount + 2            CurrOppSegCount = CurrOppSegCount - 1        Else ' project the buldge on the new line            ' set angle3 to the perpendicular of the second line            If Plus Then                angle3 = Dir2 + dtr(90)            Else                angle3 = Dir2 - dtr(90)            End If            ' set the existing            NewCoords(currentY + 1) = pt2(x): NewCoords(currentY + 2) = pt2(y)            ' do the opposite            varRet = ThisDrawing.Utility.PolarPoint(pt2, angle2, dOffset)            NewCoords(currentOppY - 3) = varRet(x): NewCoords(currentOppY - 2) = varRet(y)            varRet = ThisDrawing.Utility.PolarPoint(pt2, angle3, dOffset)            NewCoords(currentOppY - 5) = varRet(x): NewCoords(currentOppY - 4) = varRet(y)            ' reset the running counts of y placeholders            currentY = currentY + 2            currentOppY = currentOppY - 4            ' set the buldge and move the counters            BulgeArray(J) = CurrOppSegCount            AngleArray(J) = Tan((dtr(180) - angle1) / 4)            CurrOppSegCount = CurrOppSegCount - 2            CurrSegCount = CurrSegCount + 1        End If        ' If it's the last one then do the last stuff        If I = count Then ' the last one            ' reset the offset angle to match            If Plus Then                angle2 = Dir2 + dtr(90)            Else                angle2 = Dir2 - dtr(90)            End If            NewCoords(currentY + 1) = varCoords(count - 1): NewCoords(currentY + 2) = varCoords(count)            ' get the point we need            varRet = ThisDrawing.Utility.PolarPoint(pt3, angle2, dOffset)            ' set the coordinates            NewCoords(currentY + 3) = varRet(x): NewCoords(currentY + 4) = varRet(y)        End If        ' increment the buldge counter        J = J + 1    Next I    ' make the polyline    Set objNewEntity = ThisDrawing.ModelSpace.AddLightWeightPolyline(NewCoords)    ' do the bulges    Dim tmpDir As Double    For J = 0 To UBound(BulgeArray)        ' which direction        If Plus Then            tmpDir = AngleArray(J)        Else            tmpDir = -AngleArray(J)        End If        objNewEntity.SetBulge BulgeArray(J), tmpDir    Next J        objNewEntity.Closed = True        ' update the pline    objNewEntity.Update        ' find the size of the object drawn so we can calculate the viewport    ' and determine the scale factor    Dim varMin As Variant    Dim varMax As Variant    Dim Width As Double    Dim Height As Double    objNewEntity.GetBoundingBox varMin, varMax        ' set the center point to be used by the viewport code    Ipt(0) = ((varMax(0) - varMin(0)) / 2) + varMin(0)    Ipt(1) = ((varMax(1) - varMin(1)) / 2) + varMin(1)        ' get the height and width    Width = varMax(0) - varMin(0) + dOffset    Height = varMax(1) - varMin(1) + dOffset        If Width > 9.3 Or Height > 6.5 Then        ThisDrawing.SetVariable "Dimscale", 2        ViewScale = 0.5    Else        ThisDrawing.SetVariable "Dimscale", 1        ViewScale = 1    End If        ' dimension the original one    Call DoDims(varCoords, ObjEntity)    End Sub' takes a vector and a direction from the vector and returns' whether or not the offset side perpendicular would be an addition' of ninety degrees or a subtraction of ninety degrees from the' original vector directionPrivate Function isPlus(Vector As Double, Side As Double) As Boolean    Dim angle1 As Double    Dim angle2 As Double    angle1 = Vector    angle2 = Vector + dtr(180)    If angle2 > dtr(360) Then angle2 = angle2 - dtr(360)    If angle2 > angle1 Then ' angle 2 is the large one        If Side > angle1 And Side < angle2 Then            isPlus = True        Else            isPlus = False        End If    Else ' angle 1 is the large one        If Side > angle2 And Side < angle1 Then            isPlus = False        Else            isPlus = True        End If    End IfEnd Function' get's the smallest angle of two vectorsPrivate Function SmallAngle(Vector1 As Double, Vector2 As Double) As Double    ' subtract the smaller angle from the smaller one    If Vector1 > Vector2 Then        SmallAngle = Vector1 - Vector2    Else        SmallAngle = Vector2 - Vector1    End If    If SmallAngle > dtr(180) Then SmallAngle = dtr(360) - SmallAngleEnd FunctionPrivate Sub cmdGo_Click()    ' get the aluminum thickness and select the    ' modifier and the thickness    Select Case listType.ListIndex        Case 0            dblModifier = 0.076            dOffset = 0.05        Case 1            dblModifier = 0.095            dOffset = 0.0625        Case 2            dblModifier = 0.1425            dOffset = 0.09        Case 3            dblModifier = 0.19            dOffset = 0.125        Case 4            dblModifier = 0.285            dOffset = 0.1875        Case Else        ' this should never happen so inform the user and exit            MsgBox "Something is wrong, see the programmer: "            Exit Sub    End Select    Me.Hide    Call Go    Call MakeLayoutEnd SubPrivate Sub DoDims(varCoords As Variant, ObjEntity As AcadEntity)    Dim txtHeight As Double    Dim DimOffset As Double    ' the three points necessary to build an angular dimension    Dim pt1(0 To 2) As Double    Dim pt2(0 To 2) As Double    Dim pt3(0 To 2) As Double    ' running blank and total length    Dim dblLength As Double    Dim dblTotalLength As Double    ' included angle for calculations    Dim dblAngle As Double    ' distance between the 2 end points for calculating    ' the dimension text location    Dim dblDist As Double    ' use x for x and y for y, z for z if needed    Const x = 0: Const y = 1: Const z = 2    ' integer counter    Dim I As Integer    ' left and right points for the dimensions    Dim lpt As Variant    Dim rpt As Variant    ' get the drawing scale and set the text height and dimension var's    DwgScale = ThisDrawing.GetVariable("dimscale")    txtHeight = DwgScale * 0.125    DimOffset = DwgScale * 1    ' point for the angular text location (temporary)    Dim varPT As Variant    ' dimension object (temporary)    Dim objDim As AcadDimAngular    ' set the initial length to zero    dblLength = 0    dblTotalLength = 0            ' loop thru the polyline, extract the vertexes    ' and calculate the angles, length and break distances    For I = 5 To UBound(varCoords) Step 2        ' points 1 thru 3        pt1(x) = varCoords(I - 5)        pt1(y) = varCoords(I - 4)        pt2(x) = varCoords(I - 3)        pt2(y) = varCoords(I - 2)        pt3(x) = varCoords(I - 1)        pt3(y) = varCoords(I)        ' add linear dimensions        lpt = pt1        rpt = pt2        ' get the angle of the first line so we can draw the dimension        dblAngle = ThisDrawing.Utility.AngleFromXAxis(pt1, pt2)        ' draw the dimension        Call DrawDim(lpt, rpt, DimOffset, dblAngle, "STD1")        ' test for the last line segment and if it is then draw the dimension        If I = UBound(varCoords) Then            lpt = pt2            rpt = pt3            dblAngle = ThisDrawing.Utility.AngleFromXAxis(pt2, pt3)            Call DrawDim(lpt, rpt, DimOffset, dblAngle, "STD1")        End If        ' add the length of point 1 and 2        dblLength = dblLength + Distance(pt1, pt2)        dblTotalLength = dblTotalLength + Distance(pt1, pt2)        ' get the distance of the 2 outer end points        dblDist = Distance(pt1, pt3)        ' get the angle so we can get the halfway point        dblAngle = ThisDrawing.Utility.AngleFromXAxis(pt1, pt3)        ' get the halfway point , we will use this to give us        ' a text location for the temporary dimension        varPT = ThisDrawing.Utility.PolarPoint _                    (pt1, dblAngle, 0.5 * dblDist)        ' draw the dimension        Set objDim = ThisDrawing.ModelSpace.AddDimAngular _                    (pt2, pt1, pt3, varPT)        ' get the angle between the two segments        dblAngle = rtd(objDim.Measurement)        ' if more than ninety then use the excluded angle        If dblAngle > 90 Then            dblAngle = 180 - dblAngle        End If        ' subtract the break length calculated        dblLength = dblLength - ((dblAngle / 90) * dblModifier)        ' if this is the last one then add the last chord        If I = UBound(varCoords) Then            dblLength = dblLength + Distance(pt2, pt3)            dblTotalLength = dblTotalLength + Distance(pt2, pt3)        End If    Next I    ' show the user what the length is    ' now it's time to get the text location    ' get the bounding box coordinates    Dim varMin As Variant    Dim varMax As Variant    ObjEntity.GetBoundingBox varMin, varMax        ' set the center point to be used by the viewport code    Ipt(0) = ((varMax(0) - varMin(0)) / 2) + varMin(0)    Ipt(1) = ((varMax(1) - varMin(1)) / 2) + varMin(1)        ' set the break length variable to be used in the title block    brkLength = dblLength    ' delete the original polyline because we don't need it anymore    ObjEntity.Delete    ' now, let's zoom extents so you can see it all, baby    ThisDrawing.Application.ZoomCenter Ipt, 1    End Sub`
Soli Deo Gloria

#### Draftek ##### Re: Offset a polyline
« Reply #6 on: September 28, 2005, 08:08:32 AM »
I had to break it up because it was too long

second part of the frmMain code

Code: [Select]
`Private Sub MakeLayout()    Dim strTitleBlock As String    Dim strFile    Dim I As Long    Dim objLayout As AcadLayout    Dim objViewPort As AcadPViewport    Dim objObject As AcadObject    Dim BlkRef As AcadBlockReference    Dim Ipt1(0 To 2) As Double    On Error GoTo err_Handler    strTitleBlock = "TitleBlock"    ' NOTE: The drawing 'BKML.dwg' must be in the support path    strFile = "BKMTL.dwg"    ' first, let's add the layout    Set objLayout = ThisDrawing.Layouts.Add(strTitleBlock)    ' zoom the drawint    Application.ZoomCenter Ipt, ViewScale    ' make the layout and go to paper space    ThisDrawing.ActiveLayout = ThisDrawing.Layouts(strTitleBlock)    ThisDrawing.ActiveSpace = acPaperSpace    ' set the insertion point to 0,0    Ipt1(0) = 0: Ipt1(1) = 0    ' insert the title block    Set BlkRef = ThisDrawing.PaperSpace.InsertBlock(Ipt1, strFile, 1, 1, 1, 0)    ThisDrawing.Application.ZoomCenter Ipt, ViewScale    ' set the middle of the viewport    Ipt1(0) = 4.9375: Ipt1(1) = 5#    Set objViewPort = ThisDrawing.PaperSpace.AddPViewport(Ipt1, 9.375, 6.625)    ThisDrawing.ActiveSpace = acModelSpace    ' zoom the viewport    ThisDrawing.Application.ZoomCenter Ipt, ViewScale    ' go back to paper space    ThisDrawing.ActiveSpace = acPaperSpace    objViewPort.Visible = True    objViewPort.Display True    objViewPort.StandardScale = acVpCustomScale    objViewPort.CustomScale = ViewScale    objViewPort.DisplayLocked = True    ThisDrawing.Regen acAllViewports    ThisDrawing.Application.ZoomExtents        ' now, delete all of the layouts    Set objLayout = Nothing    For Each objLayout In ThisDrawing.Layouts        If objLayout.Name = "Layout1" Then            objLayout.Delete        ElseIf objLayout.Name = "Layout2" Then            objLayout.Delete        End If    Next objLayout    ' now let's insert the Title Info and fill in the data    Dim varAttrib As Variant    Dim attribObj As AcadAttributeReference    ' the block name    strFile = "BrkInfo"    ' set the insertion point    Ipt1(0) = 0.25: Ipt1(1) = 1.1875    ' round the blank length to 3 spaces    brkLength = RoundExt(brkLength, 3)    Set BlkRef = ThisDrawing.PaperSpace.InsertBlock(Ipt1, strFile, 1, 1, 1, 0)        varAttrib = BlkRef.GetAttributes    ' fix the attributes text strings    For I = LBound(varAttrib) To UBound(varAttrib)        Set attribObj = varAttrib(I)        Select Case attribObj.TagString            Case "QUANTITY"                attribObj.TextString = "1"            Case "MARK"                attribObj.TextString = "A"            Case "DESC"                attribObj.TextString = "Description"            Case "LENGTH"                attribObj.TextString = "1"            Case "BLANK"                attribObj.TextString = CStr(brkLength)            Case "BREAKS"                attribObj.TextString = CStr(Breaks)            Case "BAYMARK"                attribObj.TextString = "Bay"            Case "REMARKS"                attribObj.TextString = "Remarks"            Case Else        End Select    Next I    ' update the blkreference    BlkRef.Update    ' Finished - Yeah    Exit Suberr_Handler:    Select Case Err.Number        Case -2145386475 ' Title block layout already exists            Err.Clear            MsgBox "You already have a Title Block Layout " & vbCr & _                    "Make sure You aren't duplicating Title BLocks"            Resume Next        Case Else            MsgBox Err.Number & " " & Err.Description    End SelectEnd SubPrivate Sub UserForm_Initialize()' fill the aluminum thickenss text box    listType.AddItem "0.05"    listType.AddItem "0.0625"    listType.AddItem "0.09"    listType.AddItem "0.125"    listType.AddItem "0.1875"    ' set the initial index to the first one    listType.ListIndex = 0End Sub`
Code: [Select]
Soli Deo Gloria

#### Draftek ##### Re: Offset a polyline
« Reply #7 on: September 28, 2005, 08:10:18 AM »
here is the code from the main module with some helper functions which I cannot take credit for a couple of them:

Code: [Select]
`'' breakmetal.dvb'' 5/2/01'' runs inside autocad to extract vertexes and lengths from'' lightweightpolylines drawn by the user to calculate the'' break length of sheetmetal'''' calculations are dependant upon the included angle of the'' vertex and the thickness of the aluminum used'''' if the included angle is greater than 90 then the opposite'' angle is used - for some reason for more than 90 degrees the'' amount adjusted is equal to the opposite side angle'''' Vba only lets me get the array of points in x and y values'' since I had to get lengths and angles I used to following techniques:'' For lengths I created a function call "Distance" using trig'' For the angles I created an angular dimension using the endpoints and'' the vertex along with a text location I calculated from a point halfway'' of an imaginary line between the two end points - pt1, and pt3'' I then extracted the measurement in radians and converted to degrees'' for the calculation and then delete the dimension' public variables' the drawing scale factorPublic DwgScale As Double' main subPublic Sub Main()    frmMain.ShowEnd Sub' get lwpolyline subPublic Function Get_Poly() As AcadLWPolyline    Dim ObjEntity As AcadLWPolyline    Dim varPoint As Variant    On Error GoTo PickError:    ThisDrawing.Utility.GetEntity _                ObjEntity, varPoint, "Please Pick a PolyLine: "    Set Get_Poly = ObjEntity    Exit FunctionPickError:    Dim Answer As Integer    ' display a message in case the user picked something    ' other than a lightweightpolyline or did not pick    ' anything at all    Answer = MsgBox("You did not pick a polyline!" _                & vbLf & "Try Again?", 52, "Break Metal")    ' if the answer is not "OK" then end the program    If Answer <> 6 Then        End    End If    ' if the answer is "OK" then try again    ResumeEnd Function' obtain distance function from 2 pointsFunction Distance(sp As Variant, ep As Variant)    Dim x As Double    Dim y As Double    Dim z As Double    x = sp(0) - ep(0)    y = sp(1) - ep(1)    z = sp(2) - ep(2)    Distance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))End Function' radians to degress functionFunction rtd(rad As Double) As Double    rtd = (rad / PI) * 180End Function' degrees to radPublic Function dtr(a As Double) As Double dtr = (a / 180) * PI()End Function' the pi forumula for the dtr and rdt functionsPublic Function PI() As Double PI = Atn(1) * 4End Function' draws a rotated dimensionSub DrawDim(lpt As Variant, rpt As Variant, Offset As Double, _                DimDir As Double, Dimtype As String)    Dim NewDimStyle As AcadDimStyle    Dim DimObj As AcadDimRotated    Dim LdimPt(0 To 2) As Double    Dim RdimPt(0 To 2) As Double    Dim DimLoc(0 To 2) As Double    Dim TempVar As Variant    Dim DimDir90 As Double    On Error GoTo BlkError    ' set the current dimension style to the Dimtype parameter    ' passed to the program    Set NewDimStyle = ThisDrawing.DimStyles.Item(Dimtype)    ThisDrawing.ActiveDimStyle = NewDimStyle    ThisDrawing.SetVariable "Dimscale", DwgScale    ThisDrawing.ActiveDimStyle.CopyFrom ThisDrawing    ' left and right dimension points    LdimPt(0) = lpt(0): LdimPt(1) = lpt(1)    RdimPt(0) = rpt(0): RdimPt(1) = rpt(1)    TempVar = lpt    ' 90degrees from dimension direction    DimDir90 = dtr(90) + DimDir    ' get the dimension location    TempVar = ThisDrawing.Utility.PolarPoint(TempVar, DimDir90, Offset)    DimLoc(0) = TempVar(0): DimLoc(1) = TempVar(1)    ' create the dimension object    Set DimObj = ThisDrawing.ModelSpace.AddDimRotated(LdimPt, RdimPt, DimLoc, DimDir)    Exit SubBlkError:    Select Case Err.Number        Case -2145386476 ' dimstyle does not exist            Resume Next        Case Else            Exit Sub    End SelectEnd Sub' checks to see if a number is even or NOTPublic Function isEven(iNum As Integer) As Boolean    Dim Answer As Boolean    If iNum Mod 2 = 0 Then        Answer = True    Else        Answer = False    End If    isEven = AnswerEnd Function`
hope this helps...
Soli Deo Gloria

#### Troy Williams

• Guest ##### Re: Offset a polyline
« Reply #8 on: October 03, 2005, 08:36:43 AM »
Draftek, thank you for posting the code! I will take a look at it and see how it works.

Thanks again!

#### Kerry ##### Re: Offset a polyline
« Reply #9 on: October 03, 2005, 10:34:08 AM »
hmmmmmm .. wonder what hatch is doing these days ?
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

#### gilseorin

• Guest ##### Re: Offset a polyline
« Reply #10 on: February 26, 2007, 12:54:41 PM »
Thank you Draftek!
I do need this, but it returns error message.
Could you repair it available and upload it.
Helping me,much much ...... appreciated.

#### DaveW

• Guest ##### Re: Offset a polyline
« Reply #11 on: March 06, 2007, 11:33:03 PM »
I deal with closed polyines, so you may have to adjust the code and make it deal with one more vertex.

This code offsets a polyline. The returned area if bigger or smaller tells you the direction of the verticies too.

Code: [Select]
`Public Function DirPolSante(polyEnt As AcadEntity) As StringDim OffsetObj As VariantDim AreaObj As DoubleDim AreaOffset As DoubleAreaObj = polyEnt.AreaOffsetObj = polyEnt.Offset(0.01)AreaOffset = OffsetObj(0).AreaOffsetObj(0).DeleteIf AreaOffset < AreaObj ThenVertDir = "Clockwise"ElseVertDir = "CounterClockwise"End IfEnd Function`
this finds the area if needed:
Code: [Select]
`Public Function polyArea(arrPts() As Double) As DoubleDim intloop As IntegerDim intLow As IntegerDim intHigh As IntegerDim dblArea As DoubleintLow = LBound(arrPts)intHigh = UBound(arrPts)For intloop = intLow To intHigh - 3 Step 3dblArea = dblArea + (arrPts(intloop) * arrPts(intloop + 4)) - (arrPts(intloop + 0) * arrPts(intloop + 1))Next intloopdblArea = dblArea + (arrPts(intHigh - 1 * arrPts(1))) - (arrPts(intHigh - 1) * arrPts(0))polyArea = dblArea / 2polyArea2 = polyAreaEnd Function`
This reverses a open LWpolyline:
Code: [Select]
`Private Sub revPline(polyEnt As AcadLWPolyline)        Dim idx As Integer        Dim numPts As Integer        Dim numBulge As Integer        Dim bulge As Double'set an array to store the coordinates of the pline        Dim newcoord() As Double        numPts = UBound(polyEnt.Coordinates) - 1        ReDim newcoord(numPts + 1)'set an array to store the bludge factor for each segment        Dim newbulge() As Double        numBulge = ((numPts - 3) / 2)                If ((UBound(polyEnt.Coordinates) + 1) / 2) Mod 2 = 0 Then           GoTo myout        Else           numBulge = numBulge + 1        End Ifmyout:        ReDim newbulge(numBulge)'loop through the vertices of the pline and save x,y in reverse order        For idx = 0 To numPts Step 2            newcoord(numPts - idx) = polyEnt.Coordinates(idx)            newcoord(numPts - idx + 1) = polyEnt.Coordinates(idx + 1)        Next idx'loop through the bulge factors and save in reverse order        For idx = 0 To numBulge            newbulge(numBulge - idx) = polyEnt.GetBulge(idx) * -1        Next idx        'reverse the original pline        polyEnt.Coordinates = newcoord                For idx = 0 To numBulge            polyEnt.SetBulge idx, newbulge(idx)        Next idx                polyEnt.UpdateEnd Sub`
This reverses a closed LWpolyline:
Code: [Select]
`Private Sub reverse_pline(polyEnt As AcadLWPolyline)        Dim idx As Integer        Dim numPts As Integer        Dim numBulge As Integer        Dim bulge As Double'set an array to store the coordinates of the pline        Dim newcoord() As Double        numPts = UBound(polyEnt.Coordinates) - 1 'was -1        ReDim newcoord(numPts + 1) 'was 1'set an array to store the bludge factor for each segment        Dim newbulge() As Double        numBulge = (((numPts)) / 2)  'was -3)/2        ReDim newbulge(numBulge)'loop through the vertices of the pline and save x,y in reverse order        For idx = 0 To numPts Step 2            newcoord(numPts - idx) = polyEnt.Coordinates(idx)            newcoord(numPts - idx + 1) = polyEnt.Coordinates(idx + 1) 'was +1 in 2 places        Next idx'loop through the bulge factors and save in reverse order        For idx = 0 To numBulge          If idx <> numBulge Then            newbulge(numBulge - idx) = polyEnt.GetBulge(idx) * -1                        Else                        newbulge(0) = polyEnt.GetBulge(idx) * -1                      End If        Next idx        'reverse the original pline        polyEnt.Coordinates = newcoord                For idx = 0 To numBulge                  If idx = 0 Then            polyEnt.SetBulge (numBulge), newbulge(idx)          Else            polyEnt.SetBulge (idx - 1), newbulge(idx)          End If                    Next idx                polyEnt.UpdateEnd Sub`

This converts a LWpolyline toa  2D polyline. Great for older CNC programs when you have to have 2D poly a tthe end of your code. ACAD does a much better with Pedit on LW polylines (sendcommand):
Code: [Select]
`Public Function polyentconvert(polyEnt As Object) As AcadPolylineDim entity As AcadDocumentSet entity = AutoCAD_Application.ActiveDocument Dim I As Integer, j As Integer, K As Integer If polyEnt.EntityName = "AcDbPolyline" Then  Dim Coords As Variant  Coords = polyEnt.Coordinates  I = Fix((UBound(Coords) + 1) * 1.5) - 1  ReDim Coords2(I) As Double  j = 0  Dim X As Double, y As Double, z As Double  For I = LBound(Coords) To UBound(Coords) Step 2    X = Coords(I): y = Coords(I + 1): z = 0#    Coords2(j) = X:    Coords2(j + 1) = y:    Coords2(j + 2) = z:    j = j + 3  Next I  Dim Coords2V As Variant  Coords2V = Coords2  Dim EN2 As AcadPolyline  Set EN2 = entity.ModelSpace.AddPolyline(Coords2V)  EN2.Closed = polyEnt.Closed  EN2.Color = polyEnt.Color  EN2.Linetype = polyEnt.Linetype  EN2.Thickness = polyEnt.Thickness    EN2.Layer = polyEnt.Layer  Dim b As Double, w As Double, W2 As Double  For I = 0 To UBound(Coords) Step 2    j = I / 2    b = polyEnt.GetBulge(j)    polyEnt.GetWidth j, w, W2    EN2.SetBulge j, b    EN2.SetWidth j, w, W2  Next I  Dim polyentx As AcadPolyline  Set polyentx = EN2  polyEnt.Delete End IfEnd Function`

Most of this code can be contributed to Malcom Fernadaz. His code delt with open polylines. I modified it to deal with closed ones
« Last Edit: March 06, 2007, 11:54:39 PM by DaveW »

#### gilseorin

• Guest ##### Re: Offset a polyline
« Reply #12 on: March 15, 2007, 03:44:03 PM »
Thank you so much,Davew!