Problem with polyline.GetBulge, why does it fail on my LW Polyline?

Discussion in 'AutoCAD' started by Bert Eding, Nov 23, 2004.

  1. Bert Eding

    Bert Eding Guest

    See the program below, at the point where I call GetBulge, i get always zero
    (and Error), the GetBulge function simply fails.
    Although I am sure that my polyline contains some bulges.
    The Example below calculates the total length of a pline.

    The VBA help of acad says this:
    Remarks

    Polyline: this method will fail if the polyline Type property is not
    acSimplePoly.


    So, I Guess my polyline is not a acSimplePoly, but why not and how do I
    influence it is the question?
    And if so, how do I get the bulge if not a acSimplePoly?


    What is wrong?

    Bert



    Public Sub PolyLineLength()

    Dim x1 As Double
    Dim x2 As Double
    Dim y1 As Double
    Dim y2 As Double
    Dim bulge As Double
    Dim coords As Variant
    Dim i As Long
    Dim j As Long
    Dim totalDist As Double
    Dim lb As Long
    Dim ub As Long

    'Begin the selection
    Dim returnObj As AcadLWPolyline
    Dim basePnt As Variant
    On Error Resume Next

    SelectPolyLine returnObj

    coords = returnObj.Coordinates
    lb = LBound(coords)
    ub = UBound(coords)
    j = 0
    For i = lb To ub - 2 Step 2
    bulge = returbObj.GetBulge(i / 2)
    x1 = coords(i)
    y1 = coords(i + 1)
    x2 = coords(i + 2)
    y2 = coords(i + 3)
    If bulge = 0 Then
    totalDist = totalDist + Calculate3DDistance(x1, y1, 0, x2, y2,
    0)
    Else
    j = j + 1
    totalDist = totalDist + CalculateArcLength(x1, y1, 0, x2, y2, 0,
    bulge)
    End If
    Next i
    'nr Of Arcs is always zero????????????
    MsgBox "The lenghth of the polyline = " & totalDist & " nr Of Arcs =
    " & j

    End Sub

    Private Function Calculate3DDistance(x1 As Double, _
    y1 As Double, _
    z1 As Double, _
    x2 As Double, _
    y2 As Double, _
    z2 As Double) As Double


    Calculate3DDistance = Sqr(((x2 - x1) ^ 2 + (y2 - y1) ^ 2 + (z2 - z1) ^
    2))


    End Function

    Private Function CalculateArcLength(x1 As Double, _
    y1 As Double, _
    z1 As Double, _
    x2 As Double, _
    y2 As Double, _
    z2 As Double, _
    bulge As Double) _
    As Double

    Dim alpha As Double
    Dim theta As Double
    Dim x As Double
    Dim radius As Double

    x = Calculate3DDistance(x1, y1, z1, x2, y2, z2) / 2
    alfa = 2 * Atn(bulge) 'Calculate 1/2 the included angle
    theta = 2 * alpha 'Calculate the included angle
    radius = x / Sin(alpha) 'Calculate the radius
    CalculateArcLength = theta * radius 'Calculate the arclength


    End Function


    Private Sub SelectPolyLine(ByRef object As AcadEntity)
    ' The following example waits for a selection from the user

    On Error GoTo ErrorHandling

    RETRY:
    ThisDrawing.Utility.GetEntity object, basePnt, "Select a polyline"

    If Err <> 0 Then
    Err.Clear
    MsgBox "Please select something", , "Select a polyline"
    GoTo RETRY
    Else
    object.Update
    If object.ObjectName <> "AcDbPolyline" Then
    MsgBox "The object type is: " & returnObj.EntityName & "Please
    select a polyline", , "GetEntity Example"
    GoTo RETRY
    End If
    End If
    object.Update
    Exit Sub

    ErrorHandling:
    MsgBox "Error" & Err.Description
    Err.Clear
    Resume Next

    End Sub
     
    Bert Eding, Nov 23, 2004
    #1
    1. Advertisements

  2. Bert Eding

    Jeff Guest

    Bert,
    I'm not sure why your code was failing, unless you cut/pasted your code to
    your message.....at which point I must suggest you use Option Explicit at
    the beginning of your modules. That way the VBAIDE will catch any spelling &
    syntax errors. After making some minor modifications, the following works
    just fine for me.....

    Option Explicit

    Public Sub PolyLineLength()

    Dim x1 As Double
    Dim x2 As Double
    Dim y1 As Double
    Dim y2 As Double
    Dim bulge As Double
    Dim coords As Variant
    Dim i As Long
    Dim j As Long
    Dim totalDist As Double
    Dim lb As Long
    Dim ub As Long

    'Begin the selection
    Dim returnObj As AcadLWPolyline
    Dim basePnt As Variant
    On Error Resume Next

    SelectPolyLine returnObj

    coords = returnObj.Coordinates
    lb = LBound(coords)
    ub = UBound(coords)
    j = 0
    For i = lb To ub - 2 Step 2
    bulge = returnObj.GetBulge(i / 2)
    x1 = coords(i)
    y1 = coords(i + 1)
    x2 = coords(i + 2)
    y2 = coords(i + 3)
    If bulge = 0 Then
    totalDist = totalDist + Calculate3DDistance(x1, y1, 0, x2, y2,
    0)
    Else
    j = j + 1
    totalDist = totalDist + CalculateArcLength(x1, y1, 0, x2, y2, 0,
    bulge)
    End If
    Next i
    'nr Of Arcs is always zero????????????
    MsgBox "The lenghth of the polyline = " & totalDist & vbCrLf &
    "Number Of Arcs =" & j

    End Sub

    Private Function Calculate3DDistance(x1 As Double, _
    y1 As Double, _
    z1 As Double, _
    x2 As Double, _
    y2 As Double, _
    z2 As Double) As Double


    Calculate3DDistance = Sqr(((x2 - x1) ^ 2 + (y2 - y1) ^ 2 + (z2 - z1) ^
    2))


    End Function

    Private Function CalculateArcLength(x1 As Double, _
    y1 As Double, _
    z1 As Double, _
    x2 As Double, _
    y2 As Double, _
    z2 As Double, _
    bulge As Double) _
    As Double

    Dim alpha As Double
    Dim theta As Double
    Dim x As Double
    Dim radius As Double

    x = Calculate3DDistance(x1, y1, z1, x2, y2, z2) / 2
    alpha = 2 * Atn(bulge) 'Calculate 1/2 the included angle
    theta = 2 * alpha 'Calculate the included angle
    radius = x / Sin(alpha) 'Calculate the radius
    CalculateArcLength = theta * radius 'Calculate the arclength


    End Function

    Private Sub SelectPolyLine(ByRef object As AcadEntity)
    ' The following example waits for a selection from the user
    Dim basePnt As Variant
    On Error GoTo ErrorHandling

    RETRY:
    ThisDrawing.Utility.GetEntity object, basePnt, "Select a polyline"

    If Err <> 0 Then
    Err.Clear
    MsgBox "Please select something", , "Select a polyline"
    GoTo RETRY
    Else
    object.Update
    If object.ObjectName <> "AcDbPolyline" Then
    MsgBox "The object type is: " & object.EntityName & "Please
    select a polyline", , "GetEntity Example"
    GoTo RETRY
    End If
    End If
    object.Update
    Exit Sub

    ErrorHandling:
    MsgBox "Error" & Err.Description
    Err.Clear
    Resume Next

    End Sub
     
    Jeff, Nov 25, 2004
    #2
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.