CADForums.net

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

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
check out www.cadvault.com
"Bert Eding" <bert-eding@nospam.nl> wrote in message
news:co00dh$cjd$1@reader08.wxs.nl...

	CADForums.net Forum Index -> AutoCAD	All times are GMT
Page 1 of 1