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
Reply With Quote
