Topic: Lisp to add & total every line/pline on a layer??

[StykFacE]

Hey everyone, I have seen Lisp routines before where you can select multiple lines and/or plines and it will add up the total length. Tried doing a search on here but I guess I'm not having any luck.... can anyone point to one? Thanks in advance. If not, no worries, just thought of something that might be of interest to our estimators here in the office.... 

[Matt__W]

http://www.turvill.com/t2/free_stuff/index.htm

Check out TLEN.lsp

[StykFacE]

Awesome, thanks once again Matt. If you (or anyone) know of any other variations of this type of program, please let me know. But this definitely get's what I need done. 

[architecture68-raff]

totlen.lsp is the one I've used in the past

http://www.geodesk.com.br/autolisp/totlen.lsp

[architecture68-raff]

Version I have saved is newer than the one I posted above....since author allows allows code to be posted I figured it's ok to put here

Code: [Select]

;| TOTLEN.LSP    c.2000  Rob Herr    robherr@hotmail.com
 'Add selected lines, plines, lwplines, splines, and arcs for total length'

 Revisions:
1.0 Originally created 02/10/2000 Rob Herr
1.1 Added support for 4 Units 02/29/2000 Jeff Tippit
Arch, Deci-Arch, Engr, Deci-Engr
  ___________________________________________________________________
  |     PERMISSION HEREBY GRANTED BLA, BLA, BLA, TO MODIFY ETC.     |
  |   As long as name and email remain with the original program    |
  | unaltered. However I would like to know of any bugs or problems |
  |   that arise with the actual program. And of course I take no   |
  |  responsibility for lost limbs, auto repair bills, mechanical   |
  |         or electronic difficulties, or snake venom.             |
  -------------------------------------------------------------------

------------------------------------------------------------------------
 Modified by J. Tippit, SPAUG President
    E-mail:                     cadpres@spaug.org
    Web Site:                http://www.spaug.org
------------------------------------------------------------------------

|;

(defun tlines ()
  (setq lbeg (cdr (assoc '10 ent)))
  (setq lend (cdr (assoc '11 ent)))
  (setq llen (distance lbeg lend))
  (setq tlen (+ tlen llen))
  (ssdel sn ss1)
)

(defun tarcs ()
 (setq cen (cdr (assoc '10 ent)))
 (setq rad (cdr (assoc '40 ent)))
 (setq dia (* rad 2.0))
 (setq circ (* (* rad pi) 2.0))
 (setq sang (cdr (assoc '50 ent)))
 (setq eang (cdr (assoc '51 ent)))
 (if (< eang sang)
  (setq eang (+ eang (* pi 2.0)))
 )
 (setq tang (- eang sang))
 (setq tang2 (* (/ tang pi) 180.0))
 (setq circ2 (/ tang2 360.0))
 (setq alen (* circ2 circ))
 (setq tlen (+ tlen alen))
 (princ)
 (ssdel sn ss1)
)

(defun tplines ()
 (command "area" "e" sn)
 (setq tlen (+ tlen (getvar "perimeter")))
 (ssdel sn ss1)
)

(defun tsplines ()
 (command "area" "e" sn)
 (setq tlen (+ tlen (getvar "perimeter")))
 (ssdel sn ss1)
)

(DEFUN C:TOTLEN (/ tlen ss1 sn sn2 et)
 (setq cmdecho (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (setq tlen 0)  
 (prompt "\nSelect only those entities you want for total length: ")
 (setq ss1 (ssget))
 (while (> (sslength ss1) 0)
  (setq sn (ssname ss1 0))
  (setq ent (entget sn))
  (setq et (cdr (assoc '0 ent)))
  (cond
   ((= et "LINE") (tlines))
   ((= et "ARC") (tarcs))
   ((= et "LWPOLYLINE") (tplines))
   ((= et "POLYLINE") (tplines))
   ((= et "SPLINE") (tsplines))
   ((or
     (/= et "LINE")
     (/= et "ARC")
     (/= et "LWPOLYLINE")
     (/= et "POLYLINE")
     (/= et "SPLINE")
    )
    (ssdel sn ss1)
   )
  )
 )
     (alert
        (strcat
           "The Total Length of Selected Lines, Polylines, and Arcs is: "
           "\n\n" "Arch\t->\t" (rtos tlen 4 6)
           "\n\n" "Engr\t->\t" (rtos (/ tlen 12) 2 3) "'"
           "\n\n" "Deci-Arch\t->\t" (rtos (* tlen 12) 4 6)
           "\n\n" "Deci-Engr\t->\t" (rtos tlen 2 3)
        )
     )
     (prompt
        (strcat
           "\nThe Total Length of Selected Lines, Polylines, and Arcs is: "
           "\n" "Arch\t\t->\t" (rtos tlen 4 6)
           "\t\t\t" "Engr\t\t->\t" (rtos (/ tlen 12) 2 3) "'"
           "\n" "Deci-Arch\t->\t" (rtos (* tlen 12) 4 6)
           "\t\t\t" "Deci-Engr\t->\t" (rtos tlen 2 3)
        )
     )
; (alert (strcat "\nThe Total Length of Selected Lines, Polylines, and Arcs is: " (rtos tlen 2 2)))
 (setvar "cmdecho" cmdecho)
 (princ)
)
(prompt "\nBy Rob Herr   robherr@hotmail.com  ")
(prompt "\nType TOTLEN to run.\tVersion 1.1 - Total Length routine ")
(princ)


[CAB]

Another:

Code: [Select]

;;;=======================[ LengthByLayer.lsp ]=========================
;;; Author: Copyright© 2007 Charles Alan Butler
;;; Version:  1.0 Dec. 26, 2007
;;; Version:  1.1 Nov. 28, 2008 Added 3dPline
;;; Purpose: display the length of objects on layer(s)
;;; Object Types allowed are LINE LWPOLYLINE POLYLINE 3dPOLYLINE SPLINE ARC CIRCLE
;;; Returns: -NA 
;;;==============================================================

(defun c:LBL()(c:LengthByLayer))
(defun c:LengthByLayer (/ cur_opt entlst ent_allowed filter layfilter len
                        mode ss tmp total_len txt_opt typ OutStr)
  (vl-load-com)
  ;|
     mode
   An integer specifying the linear units mode. The mode corresponds to the
     values allowed for the AutoCAD system variable lunits and can be one of
     the following numbers:
   1  Scientific
   2  Decimal
   3  Engineering (feet and decimal inches)
   4  Architectural (feet and fractional inches)
   5  Fractional
   nil  default to DWG settings
  |;
  (setq mode (getvar "LUNITS"))
 
  (defun put_txt (txt / pt th)
    ;;  Check if the drawing height is set to 0:
    (if (setq pt (getpoint "\nPick Text Location..."))
     (progn
      (if (= 0 (setq th (cdr (assoc 40 (tblsearch "style"  (getvar "textstyle"))))))
        (setq th (getvar "textsize"))
      )
      (entmake (list (cons 0 "TEXT")
               (cons 1 txt)
               (cons 7 (getvar "textstyle"))
               (cons 10 pt)
               (cons 40 th)
      ))
     )
      (prompt "\n***  Text Insert skipped  ***")
    )
  )

  (initget "Yes No" )
  (setq txt_opt (getkword "\nPut text total in drawing [Yes/No]. <No>"))
  (or txt_opt (setq txt_opt "No"))

  (initget "Yes No" )
  (setq cur_opt (getkword "\nCurrent Space Only? [Yes/No] No for entire DWG. <Yes>"))
  (or cur_opt (setq cur_opt "Yes"))

  (prompt "\nSelect object(s) for layer filter.")
  (if (setq ss (ssget))
    (progn
      (setq tmp (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
            tmp (mapcar '(lambda(x) (cdr(assoc 8 (entget x)))) tmp)
            layFilter "")
      (mapcar '(lambda(x) (setq layFilter (strcat x "," layFilter))) tmp)
      (setq ent_allowed '("LINE" "LWPOLYLINE" "POLYLINE" "SPLINE" "ARC" "CIRCLE"))
       (setq Filter
        '((-4 . "<or") (0 . "LINE") (0 . "CIRCLE") (0 . "ARC")
                  (-4 . "<and") (0 . "*POLYLINE") ; include LWPolylines CAB 11.28.08
                    (-4 . "<not") (-4 . "&") (70 . 80) ; exclude mesh
                    (-4 . "not>")
                  (-4 . "and>")
               (-4 . "or>")
             )
      )
      (setq Filter (append Filter (list(cons 8 layFilter))))
      (if (= cur_opt "Yes")
        (setq Filter (cons (cons 410 (getvar "ctab")) Filter))
      )
      (if (setq ss (ssget "_X" Filter))
        (progn
          (setq entlst (mapcar 'cadr (ssnamex ss))
                total_len 0)
          (foreach en entlst
            (if (vl-position (setq typ (cdr (assoc 0 (entget en)))) ent_allowed)
              (setq len (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
                    total_len (+ len total_len))
            )
          )
        )
        (prompt "\n***  Nothing on that layer with a length.  ***")
      )
    )
  )
  (and total_len (not (zerop total_len))
       (setq OutStr (strcat "Total length is " (if mode (rtos total_len mode)(rtos total_len))))
       (princ (strcat "\n" OutStr)) ; display on command line
       (if (= txt_opt "Yes") (put_txt OutStr))
  )
  (princ)
)
(prompt "\nGet Length By Layer loaded, Enter LBL to run")
(princ)

[StykFacE]

CAB, you da man. That might be the best candidate for what I'm trying to accomplish.... Thanks a million. 

EDIT** Oh and thanks to everyone else for their time. I have tried them all and they are all very useful.

[VVA]

My five cent
Calculates the length of all line primitives in layers, taking into account the scale factor

Code: [Select]

(defun c:mlen4 (/ m ss clist temp)
  ;;;Command MLEN4
  ;;;posted http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=44&TID=20298&PAGEN_1=2
  (defun sort (lst predicate)
    (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst predicate))
  )
  (defun combine (inlist is-greater is-equal / sorted current result)
    (setq sorted (sort inlist is-greater))
    (setq current (list (car sorted)))
    (foreach item (cdr sorted)
      (if (apply is-equal (list item (car current)))
   (setq current (cons item current))
   (progn
     (setq result (cons current result))
     (setq current (list item))
   )
      )
    )
    (cons current result)
  )
  (defun mlen3_1 (lst / sum_len)
    (setq sum_len 0)
    (foreach item (mapcar 'car lst)
      (setq
   sum_len   (+ sum_len
         (if (vlax-property-available-p item 'length)
           (vla-get-length item)
           (cond
             ((=
           (strcase (vla-get-objectname item) t)
           "acdbarc"
         ) ;_  =
         (vla-get-arclength item)
             )
             ((=
           (strcase (vla-get-objectname item) t)
           "acbcircle"
         ) ;_  =
         (* pi 2.0 (vla-get-radius item))
             )
             (t 0.0)
           ) ;_  cond
         ) ;_  if
      ) ;_  +
      )
    )
    (if   (not (zerop sum_len))
      (princ
   (strcat "\n\t" (cdadr lst) " = " (rtos (* sum_len m) 2 4))
      )
    )
  )
  (vl-load-com)
  (and
    (setq m (getreal "\nEnter scale factor: "))
    (setq ss (ssget "_:L"))
    (setq ss (mapcar
          (function vlax-ename->vla-object)
          (vl-remove-if
       (function listp)
       (mapcar
         (function cadr)
         (ssnamex ss)
       ) ;_  mapcar
          ) ;_ vl-remove-if
        )
    )
    (mapcar '(lambda (x)
          (setq temp (cons (cons x (vla-get-Layer x)) temp))
        )
       ss
    )
    (setq clist   (combine temp
          '(lambda (a b)
             (> (cdr a) (cdr b))
           )
          '(lambda (a b)
             (eq (cdr a) (cdr b))
           )
      )
    )
    (princ
      "\n\n The total length of all line primitives in layers:"
    )
    (mapcar 'mlen3_1 clist)
  )
  (princ)
) ;_  defun