How to get the length of a spline

[Proctor]

Hello: I'm writing a small script in vba and need to get the length of a spline for some calculations. I see that length is not a property of AcadSpline linetype. Does anyone know how I can go about doing this?

 

Thanks,

Proctor

[CADken]

select the spline, type "list" > enter?

 

sorry i'm not following your post 100%

[Proctor]

that's great...I love that trick....but, how can I get the length via my vba script (intellisense doesn't have length for spline):

 

 

for my line...I entered:

Dim MyLine As AcadLine

MyLineLength = MyLine.Length(intellisense has length listed for line)

 

but when I go to do this for my spline:

Dim MySpline As AcadSpline

MyLineLength = MySpline. (intellisense doesn't have length listed for spline)

 

any ideas..and thanks again for your help.

[Bryco]

Google the Curve.cls

This is a class that uses lisp through vba to access the acad math class.

[fixo]

Try this but dirty method with using of SenCommand

this worked good for me though

Take a look at 'GetCurveLength' function in the code

 

Option Explicit


Function TotLen(oSset As AcadSelectionSet) As Double
Dim oEnt As AcadEntity
For Each oEnt In oSset
   If TypeOf oEnt Is AcadPolyline Or _
   TypeOf oEnt Is AcadLWPolyline Or _
   TypeOf oEnt Is AcadLine Then
       TotLen = TotLen + oEnt.Length
   ElseIf TypeOf oEnt Is AcadArc Then
       TotLen = TotLen + oEnt.ArcLength
   ElseIf TypeOf oEnt Is AcadCircle Then
       TotLen = TotLen + oEnt.Circumference
   ElseIf TypeOf oEnt Is AcadSpline Then
       TotLen = TotLen + GetCurveLength(oEnt)
   ElseIf TypeOf oEnt Is AcadEllipse Then
       TotLen = TotLen + GetCurveLength(oEnt)
   End If
Next oEnt
End Function

Function [b][color=red]GetCurveLength[/color][/b](oEnt As AcadEntity) As Double
Dim sVar
sVar = 0
Dim strCom As String
With ThisDrawing
.SetVariable "USERR1", sVar
.SendCommand "(vl-load-com)" & vbCr
strCom = "(setvar " & Chr(34) & "USERR1" & Chr(34) & Chr(32) & "(vlax-curve-getdistatparam (vlax-ename->vla-object (handent " & Chr(34) & oEnt.Handle & Chr(34) & ")) (vlax-curve-getendparam (vlax-ename->vla-object (handent " & Chr(34) & oEnt.Handle & Chr(34) & ")))))" & vbCr
.SendCommand strCom
GetCurveLength = .GetVariable("USERR1")
End With
End Function

Sub TryIt()
Dim oSset As AcadSelectionSet
Dim oEnt
Dim fcode(0) As Integer
Dim fData(0) As Variant
Dim dxfCode, dxfdata
Dim i As Integer
Dim SetName As String

' create filter
fcode(0) = 0
' include the following entity types:
' LINE, LWPOLYLINE, POLYLINE, SPLINE, ARC, CIRCLE, ELLIPSE:
fData(0) = "*LINE,ARC,CIRCLE,ELLIPSE"
'
dxfCode = fcode
dxfdata = fData
'
SetName = "$Total$"
' delete all selection sets to make sure that named selection does not exist
         With ThisDrawing.SelectionSets
              While .Count > 0
                   .Item(0).Delete
              Wend
         End With
' add empty selection into selectionsets collection
Set oSset = ThisDrawing.SelectionSets.Add(SetName)
' select on screen
oSset.SelectOnScreen dxfCode, dxfdata
' display result
If oSset.Count > 0 Then
MsgBox CStr(Round(TotLen(oSset), 3)), vbInformation, "Total Length"
Else
MsgBox "0 selected, try again"
End If

End Sub

 

~'J'~

[Proctor]

thanks fatty:

 

It looks like you are calling sub routine:

GetCurveLength(oEnt As AcadEntity) As Double

which in turn, passes some vars to a lisp routine.

 

is this correct? you wouldn't happen to have the script on the lisp side - would you?

 

thanks again,

Proctor

[fixo]

Hi,

Not at all. Here it was passed to the command line the

Lisp expression only (not a sub), which calculates the length of object,

this line: (vl-load-com) load Visual Lisp (ActiveX) library

and then it calculates the distance at the end parameter

of this object, nothing else

 

~'J'~

[Proctor]

I get it now...it's working!!!

 

Thank you so much for your help...this is great!

 

Proctor

[fixo]

Always glad to help

Cheers

 

~'J'~

[Zac Davis]

Here is another example .

[Otavio]

On 1/16/2008 at 9:31 AM, fixo said:

Beautiful! This also works very well at my application.

Can you teach us how to do this(send a lisp to the command prompt) also for getting the bounding box of a SPLINE entity?

 

With VBA resources (GetBoundingBox method) do not returns the corretly values for splines...

 

On 1/16/2008 at 9:31 AM, fixo said:

Option Explicit


Function TotLen(oSset As AcadSelectionSet) As Double
Dim oEnt As AcadEntity
For Each oEnt In oSset
   If TypeOf oEnt Is AcadPolyline Or _
   TypeOf oEnt Is AcadLWPolyline Or _
   TypeOf oEnt Is AcadLine Then
       TotLen = TotLen + oEnt.Length
   ElseIf TypeOf oEnt Is AcadArc Then
       TotLen = TotLen + oEnt.ArcLength
   ElseIf TypeOf oEnt Is AcadCircle Then
       TotLen = TotLen + oEnt.Circumference
   ElseIf TypeOf oEnt Is AcadSpline Then
       TotLen = TotLen + GetCurveLength(oEnt)
   ElseIf TypeOf oEnt Is AcadEllipse Then
       TotLen = TotLen + GetCurveLength(oEnt)
   End If
Next oEnt
End Function

Function [b][color=red]GetCurveLength[/color][/b](oEnt As AcadEntity) As Double
Dim sVar
sVar = 0
Dim strCom As String
With ThisDrawing
.SetVariable "USERR1", sVar
.SendCommand "(vl-load-com)" & vbCr
strCom = "(setvar " & Chr(34) & "USERR1" & Chr(34) & Chr(32) & "(vlax-curve-getdistatparam (vlax-ename->vla-object (handent " & Chr(34) & oEnt.Handle & Chr(34) & ")) (vlax-curve-getendparam (vlax-ename->vla-object (handent " & Chr(34) & oEnt.Handle & Chr(34) & ")))))" & vbCr
.SendCommand strCom
GetCurveLength = .GetVariable("USERR1")
End With
End Function

Sub TryIt()
Dim oSset As AcadSelectionSet
Dim oEnt
Dim fcode(0) As Integer
Dim fData(0) As Variant
Dim dxfCode, dxfdata
Dim i As Integer
Dim SetName As String

' create filter
fcode(0) = 0
' include the following entity types:
' LINE, LWPOLYLINE, POLYLINE, SPLINE, ARC, CIRCLE, ELLIPSE:
fData(0) = "*LINE,ARC,CIRCLE,ELLIPSE"
'
dxfCode = fcode
dxfdata = fData
'
SetName = "$Total$"
' delete all selection sets to make sure that named selection does not exist
         With ThisDrawing.SelectionSets
              While .Count > 0
                   .Item(0).Delete
              Wend
         End With
' add empty selection into selectionsets collection
Set oSset = ThisDrawing.SelectionSets.Add(SetName)
' select on screen
oSset.SelectOnScreen dxfCode, dxfdata
' display result
If oSset.Count > 0 Then
MsgBox CStr(Round(TotLen(oSset), 3)), vbInformation, "Total Length"
Else
MsgBox "0 selected, try again"
End If

End Sub

 

 

 

~'J'~