Polylines lengths

Does anyone have a lisp that will display or output only the length of a number of polylines without giving a total length. I it to give the length of each line in the order that I select the lines even by crossing window.

Thanks

This will get you going in the right direction:

(defun c:PolyLen (/ ss)
 (vl-load-com)

 (if (ssget '((0 . "*POLYLINE")))
   (progn
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet
                              (vla-get-ActiveDocument
                                (vlax-get-acad-object))))
       (print (vla-get-length obj)))

     (vla-delete ss)))

 (princ))

PS> Why not try to learn the processes involved?

Does anyone have a VBA Macro that get the polyline total length?

Does anyone have a VBA Macro that get the polyline total length?

Example:

Sub Example_Length ()

   Dim lineObj As AcadLWPolyline
   Dim Points(0 To 9) As Double

   points(0) = 1: points(1) = 1
   points(2) = 1: points(3) = 2
   points(4) = 2: points(5) = 2
   points(6) = 3: points(7) = 2
   points( = 4: points(9) = 4

   ' Create the line in model space
   Set lineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

   ThisDrawing.Application.ZoomAll
   
   MsgBox "The length of the new Line is: " & lineObj.length
End Sub

I would like to be able to code quite easily. I have given it quite a bit of time but it doesn't come easily and I am somewhat time-poor at the moment and don't see myself getting more time to spend at it in the foreseeable future.

Thanks for your help LeeMac.

This may be of more use (works on Circles, Arcs, Lines, Polylines, Splines...)

(defun c:PLen (/ ent Len)
 (vl-load-com)

 (while
   (progn
     (setq ent (car (nentsel "\nSelect Object: ")))

     (cond (  (eq 'ENAME (type ent))

              (if (vl-catch-all-error-p
                    (setq Len
                      (vl-catch-all-apply (function vlax-curve-getDistatParam)
                        (list ent (vlax-curve-getEndParam ent)))))

                (princ "\n** Invalid Object **")
                (princ (strcat "\n-->>  Length = " (rtos Len)  "  <<--")))))))
 (princ))

     

Also, see here:

http://www.cadtutor.net/forum/showthread.php?t=42734

Does anyone have a VBA Macro that get the polyline total length?

Try this example:

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 GetCurveLength(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'~