Add up line lengths

[bmckenzie]

I need to find the total length of about 2000 lines. Is there an easy way to do this? Does anyone have a lisp routine they could offer that does this?
Thanks,

[rken.laws]

Do you want every "line" in the drawing on any layer?

[rken.laws]

try this

(defun C:all_lines()
(setvar "cmdecho" 0)
  (COMMAND "OSMODE" 0)
  (setq eset(ssget "X" ))
      (if (> (sslength eset) 0)
	(progn
      (setq cnt 0 dist 0)      
      (while (< cnt (sslength eset))        
        (setq en(ssname eset cnt))        
        (setq enlist(entget en))        
        (setq etype(cdr (assoc 0 enlist)))            
        (if (= etype "LINE")                      
           (setq dist (+ dist (distance (cdr (assoc 10 enlist)) (cdr (assoc 11 enlist))))) 
        )      
        (setq cnt(+ cnt 1))
      )
    
  
  (princ "\n Total Linear Length = ")(princ dist)
  (setvar "cmdecho" 1)
  (princ)
  )))

[steveo]

This program will total ANY line, not just LINE (was in Cadalyst, assume its fair game)

;;; LENLYR.LSP
;;; Program by Tony Hotchkiss
;;;
(defun err (s)
(if (= s "Function cancelled")
(princ "\nLENLYR - cancelled: ")
(progn (princ "\nLENLYR - Error: ") (princ s)
(terpri))
) ; if
(resetting)
(princ "SYSTEM VARIABLES have been reset\n")
(princ)
) ; err
(defun setv (systvar newval)
(setq x (read (strcat systvar "1")))
(set x (getvar systvar))
(setvar systvar newval)
) ; setv
(defun setting ()
(setq oerr *error*)
(setq *error* err)
(setv "CMDECHO" 0)
(setv "BLIPMODE" 0)
) ; end of setting
(defun rsetv (systvar)
(setq x (read (strcat systvar "1")))
(setvar systvar (eval x))
) ; restv
(defun resetting ()
(rsetv "CMDECHO")
(rsetv "BLIPMODE")
(setq *error* oerr)
) ; end of resetting

(defun dxf (code ename)
(cdr (assoc code (entget ename)))
) ; dxf

(defun lenlyr ( / LayerList EntityList EntityLengths)
(setq LayerList (get-lyrs)
EntityList (get-ents LayerList)
EntityLengths (do-len EntityList)
) ; setq
(prin1 (read (rtos EntityLengths 2 2)))
) ; lenlyr

(defun get-lyrs ( / isent lyr-list ss i lname)
(setq isent nil lyr-list nil)
(prompt
"\nSelect object(s) on required layer(s): ")
(setq ss nil)
(while (not ss)
(setq ss (ssget))
(if (not ss)
(prompt "\nNo entities were selected.")
) ; if
) ; while
(setq i (- 1))
(repeat (sslength ss)
(setq lname (dxf 8 (ssname ss (setq i (1+ i)))))
(if (not (member lname lyr-list))
(setq lyr-list (append lyr-list (list lname)))
) ; if
) ; repeat
lyr-list
) ; get-lyrs

(defun get-ents (LayerList / lstr lst lyr str
filtlist i ss ename elist)
(setq lstr (strcat (car LayerList) ","))
(setq lst (cdr LayerList))
(foreach lyr lst
(setq str (strcat lyr ",")
lstr (strcat lstr str)
) ; setq
) ; foreach
(setq lstr (substr lstr 1 (1- (strlen lstr))))
(setq filtlist (list
(cons 8 lstr)
'(-4 . "<or")
'(0 . "LINE")
'(0 . "ARC")
'(0 . "CIRCLE")
'(0 . "POLYLINE")
'(0 . "LWPOLYLINE")
'(-4 . "or>")
) ; list
) ; setq
(setq i (- 1) elist nil ss nil)
(setq ss (ssget "X" filtlist))
(if ss
(progn
(repeat (sslength ss)
(setq ename (ssname ss (setq i (1+ i))))
(setq elist (append elist (list ename)))
) ; repeat
(princ (strcat "\nTotal length of all "
"entities on layer(s) " lstr ": ")
) ; print
) ; progn
(progn
(alert (strcat "No eligible entities on "
"layer(s) \n" lstr "\naborting."))
(exit)
) ; progn
) ; if
elist
) ; get-ents

(defun do-len (EntityList / TotalLength ent len)
(setq TotalLength 0 len 0)
(foreach ent EntityList
(setq len (ent-len ent))
(if len
(setq TotalLength (+ len TotalLength))
) ; if
) ; foreach
) ; do-len

(defun ent-len (en / elength)
(setq elength
(cond
((= (dxf 0 en ) "LINE") (do-line en))
((= (dxf 0 en ) "ARC") (do-arc en))
((= (dxf 0 en ) "CIRCLE") (do-circle en))
((= (dxf 0 en ) "POLYLINE") (do-pline en))
((= (dxf 0 en ) "LWPOLYLINE") (do-lwpline en))
) ; cond
) ; setq
elength
) ; ent-len

(defun do-line (en / p10 p11 len)
(setq p10 (dxf 10 en)
p11 (dxf 11 en)
len (distance p10 p11)
) ; setq
len
) ; do-line

(defun do-arc (en / rad sang eang theta len)
(setq rad (dxf 40 en)
sang (dxf 50 en)
eang (dxf 51 en)
theta (- eang sang)
) ; setq
(if (minusp theta)
(setq theta (+ theta pi pi))
) ; if
(setq len (* rad theta))
) ; do-arc

(defun do-circle (en / rad len)
(setq rad (dxf 40 en)
len (* rad pi 2)
) ; setq
len
) ; do-circle

(defun do-pline (en / is-closed vlist vvlist len)
(setq is-closed (dxf 70 en))
(if (/= is-closed 100)
(progn
(setq en (entnext en))
(setq vlist nil
vvlist nil
) ; setq
(while (/= "SEQEND" (dxf 0 en))
(setq vlist (dxf 10 en)
vlist (reverse vlist)
vlist (cdr vlist)
vlist (list (reverse vlist))
) ; setq
(setq vlist
(append vlist (list (dxf 42 en))))
(setq vvlist (append vvlist (list vlist)))
(setq en (entnext en))
) ; while
) ; progn
) ; if
(setq len (do-polylen vvlist is-closed))
) ; do-pline

(defun do-lwpline (en / num-vert is-closed elist
vlist vvlist len)
(setq num-vert (dxf 90 en)
is-closed (dxf 70 en)
elist (entget en)
elist (member (assoc 10 elist) elist)
vlist nil
vvlist nil
) ; setq
(repeat num-vert
(setq vlist (list (cdr (assoc 10 elist))))
(setq vlist
(append vlist (list (cdr (assoc 42 elist)))))
(setq vvlist (append vvlist (list vlist)))
(setq elist (cdr elist)
elist (member (assoc 10 elist) elist)
) ; setq
) ; repeat
(setq len (do-polylen vvlist is-closed))
) ; do-lwpline

(defun do-polylen (vvlist is-closed / closed seglen
plen first p10 p11 bulge)
(setq closed (logand is-closed 1)
seglen 0
plen 0
) ; setq
(if (= closed 1)
(progn
(setq first (car vvlist)
vvlist (append vvlist (list first))
) ; setq
) ; progn
) ; if
(repeat (1- (length vvlist))
(setq p10 (caar vvlist)
p11 (caadr vvlist)
bulge (cadar vvlist)
) ; setq
(setq seglen (do-seg p10 p11 bulge))
(setq plen (+ plen seglen))
(setq vvlist (cdr vvlist))
) ; repeat
plen
) ; do-polylen

(defun do-seg (p1 p2 bulg / seglen ang4 ang dis rad)
(if (= bulg 0.0)
(progn
(setq seglen (distance p1 p2))
) ; progn
(progn
(setq ang4 (atan bulg)
ang (* 4.0 ang4)
dis (distance p1 p2)
rad (/ (/ dis 2.0) (sin (/ ang 2.0)))
seglen (* rad ang)
) ; setq
) ; progn
) ; if
seglen
) ; do-seg

(defun c:lnl ()
(setting)
(lenlyr)
(resetting)
(princ)
) ; c:lnl

(prompt "\n ")
(prompt "\nEnter LNL to start")

[CAB2k]

Another to consider:

;;;=======================[ Length.lsp ]=========================
;;; Author: Copyright© 2005-2008 Charles Alan Butler 
;;; Version:  1.1 Mar. 04,2008
;;; Purpose: display the length of a selected objects
;;;          and a running total, objects supported:
;;;    LINE, LWPOLYLINE, POLYLINE, SPLINE, ARC, CIRCLE, DIMENSION
;;; Sub_Routines: put_txt add text to dwg 
;;; Returns: -NA  
;;;==============================================================
;|
I know there are many fine "Length" routines around.
This is my version and it allows the user to pick each object & displays
the length & a running total on the command line.
An option at start up lets the user optionally put the result in the drawing.
The text is placed at the user pick point and the current text style & layer are used.
The options for text insert are:
 None - No text is inserted, this is the default
 Each - Text is inserted after each object is selected
 Total - Text is inserted only at the end of all selections & only the total is inserted.

 Exit the routine by pressing Enter or picking nothing
 Pressing C enter will clear the total
 Pressing U enter will remove the last object
 Pressing Enter while placing the text will skip the insert for that object.
|;
(defun c:length (/ en len pt txt ent_allowed total_len typ obj usercmd LenList NewTxt)
  (vl-load-com)
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (defun put_txt (txt / pt)
    ;;  Check if the drawing height is set to 0: 
    (if (setq pt (getpoint "\nPick Text Location..."))
      (progn
        (if (= 0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
          (command "text" "non" pt "" "0" txt)
          (command "text" "non" pt "0" txt)
        )
        (entlast) ; return ename
      )
      (prompt "\n***  Text Insert skipped  ***")
    )
  )

  (initget "Each Total None" )
  (setq txt_opt (getkword "\nPut text in drawing for [Each/Total/None]. <None>"))
  (or txt_opt (setq txt_opt "None"))


  (setq ent_allowed '("LINE" "LWPOLYLINE" "POLYLINE" "SPLINE" "ARC" "CIRCLE" "DIMENSION")
        total_len   0
  )
  (while (or (initget "Clear Undo")
             (setq en (entsel "\nPick object for length, [Clear/Undo]."))
         )
    (cond
      ((= "Clear" en)
       (if (member txt_opt '("Each" "Total"))
         (put_txt (strcat "Total " (rtos total_len)))
       )
       (setq total_len 0 ; clear length total
             LenList  nil)
      )
      ((= "Undo" en)
       (if LenList
         (progn
           (setq total_len (- total_len (cadar LenList)))
           (princ (strcat "\n** Removed " (caar LenList) " length = "
                          (rtos (cadar LenList)) "  Running total is " (rtos total_len)))
           (if (caddar LenList) (entdel (caddar LenList)))
           (setq LenList (cdr LenList))
         )
         (prompt "\n** No more Undo possible.")
       )
      )
      (t
       (setq en  (car en)
             obj (vlax-ename->vla-object en)
       )
       (if (member (setq typ (cdr (assoc 0 (entget en)))) ent_allowed)
         (progn
           (cond
             ((vlax-property-available-p obj 'Measurement)
              (setq len (vla-get-measurement obj))
             )
             ((setq len (vlax-curve-getdistatparam en (vlax-curve-getendparam en))))
           )
           (setq total_len (+ len total_len))
           (princ (strcat "\n" typ " length = " (rtos len)
                          "  Running total is " (rtos total_len)))
           (if (= txt_opt "Each")
             (setq NewTxt (put_txt (rtos len)))
           )
           (if LenList
             (setq LenList (cons (list typ len NewTxt) LenList))
             (setq LenList (list (list typ len NewTxt)))
           )
         )            ; progn
         (alert "Not a valid object for length")
       )
      )
    )
  ) ; while
  (and (not (zerop total_len))
       (princ (strcat "\nTotal length is " (rtos total_len)))
       (if (member txt_opt '("Each" "Total"))
         (put_txt (strcat "Total " (rtos total_len)))
       )
  )
  (setvar "CMDECHO" usercmd)
  (princ)
)
(prompt "\nGet Length loaded, Enter length to run")
(princ)

[Spiker7221]

Great routine RKEN,
But, how about a sub-total of lines of the same exact length?

try this

(defun C:all_lines()
(setvar "cmdecho" 0)
  (COMMAND "OSMODE" 0)
  (setq eset(ssget "X" ))
      (if (> (sslength eset) 0)
	(progn
      (setq cnt 0 dist 0)      
      (while (< cnt (sslength eset))        
        (setq en(ssname eset cnt))        
        (setq enlist(entget en))        
        (setq etype(cdr (assoc 0 enlist)))            
        (if (= etype "LINE")                      
           (setq dist (+ dist (distance (cdr (assoc 10 enlist)) (cdr (assoc 11 enlist))))) 
        )      
        (setq cnt(+ cnt 1))
      )
    
  
  (princ "\n Total Linear Length = ")(princ dist)
  (setvar "cmdecho" 1)
  (princ)
  )))