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

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....

Scroll down to Measurement and Dimensiong. It's called elen.lsp.

http://www.asmitools.com/Files/Programs.html

Thanks to ASMI!

Or this 1:

http://www.cadtutor.net/faq/questions/28/How+do+I+use+an+AutoLISP+routine%3F

-David

Or this...

laylen.lsp

LAYLEN.DCL

or this one extracts them to excel

(defun c:ple (/    layer layer_list leng row ss sumlen total xlApp xlCells)
 (vl-load-com)
 (if (setq ss (ssget "_X" (list (cons 0 "*POLYLINE"))))
   (progn
     (setq    xlApp (vlax-get-or-create-object "Excel.Application")
       xlCells       (vlax-get-property
                (vlax-get-property
                  (vlax-get-property
                (vlax-invoke-method
                  (vlax-get-property xlApp "Workbooks")
                  "Add")
                "Sheets")
                  "Item" 1)
                "Cells"))
     
     (vla-put-visible xlApp :vlax-true)
     (vlax-put-property xlCells "Item" 1 1 "Layer")
     (vlax-put-property xlCells "Item" 1 2 "Length")
     (setq row 2
       total 0)      
     (mapcar '(lambda (z)
        (if (not (member z layer_list))
          (setq layer_list (append (list z) layer_list))))
         (mapcar '(lambda (z) (cdr (assoc 8 (entget z)))) (mapcar 'cadr (ssnamex ss))))
     (repeat (length layer_list)
   (setq layer (car layer_list))
   (setq ss (ssget "_X" (list (cons 0 "*POLYLINE")(cons 8 layer))) sumlen 0)
   (mapcar '(lambda (z) (setq sumlen (+ sumlen (vla-get-length (vlax-ename->vla-object (cadr z)))))) (ssnamex ss))
   (vlax-put-property xlCells "Item" row 1 layer)
   (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3))
   (setq total (+ total sumlen))
   (setq layer_list (cdr layer_list))
   (setq row (+ row 1))
   )
     (setq row (+ row 1))
     (vlax-put-property xlCells "Item" row 1 "Total:")
     (vlax-put-property xlCells "Item" row 2 (rtos total 2 3))
     
     (vlax-release-object xlApp)
     (alert "Close Excel file manually")
     (gc)(gc)
     (princ)
     ) (alert "There are no Polylines on your drawing!"))
 )

This is in desperate need of an update, but I've just been too lazy and don't use it much, but since everyone is posting theirs, I just thought I'd be part of the gang.

This is in desperate need of an update, but I've just been too lazy and don't use it much, but since everyone is posting theirs, I just thought I'd be part of the gang.

 

[ATTACH]15580[/ATTACH]

Some day please update and include "circle" please !

(why not from before?)

S

Some day please update and include "circle" please !

(why not from before?)

S

I guess it's something you can use.

I think I'll sit down and do an update tonight, after the baby goes to sleep, and I'll def. add circle.

Because I'm retarded. I needed it badly a while back, wrote it, used it a few times and haven't really touched it. A buddy of mine uses it all the time for As-Built surveys.

I'll at least add circles and fix the units tonight.

Hi guys, i have code thats similar to this but i have a few problems with it.

The problem is that it calculates the lenghths of ALL polylines in the drawing.

I would like it if it only calculated the lengths of the polylines from my selection and send the totals to excel by layer.

The code i have currently looks like this:

(defun c:ple (/ elist  en   i    layer    layer_list
 leng  pline   row    ss     sumlen   total
 x  xlApp   xlBook   xlBooks  xlCells  xlSheet
 xlSheets
       )
 (vl-load-com)
 (setq xlApp    (vlax-get-or-create-object "Excel.Application")
xlBooks  (vlax-get-property xlApp "Workbooks")
xlBook    (vlax-invoke-method xlBooks "Add")
xlSheets (vlax-get-property xlBook "Sheets")
xlSheet    (vlax-get-property xlSheets "Item" 1)
xlCells    (vlax-get-property xlSheet "Cells")
 ) 
 (vla-put-visible xlApp :vlax-true)
 ;headers
 (vlax-put-property xlCells "Item" 1 1 "Layer")
 (vlax-put-property xlCells "Item" 1 2 "Length")
 
 (setq row 2
total 0)
 (setq ss (ssget "_X" (list (cons 0 "*POLYLINE"))) i -1)
 (repeat (sslength ss)
   (setq en (ssname ss (setq i (1+ i)))
  elist (entget en)
  layer (cdr (assoc 8 elist)))
   (if (not (member layer layer_list))
     (setq layer_list (cons layer layer_list))))
 
 
 (repeat (length layer_list)
   (setq layer (car layer_list))
   (vlax-put-property xlCells "Item" row 1 layer)
   (setq ss (ssget "_X" (list (cons 0 "*POLYLINE")(cons 8 layer))) i -1 sumlen 0)
   (repeat (sslength ss)
   (setq row (1+ row))  
   (setq pline (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
   (setq leng  (vlax-curve-getdistatparam pline
   (vlax-curve-getendparam pline)))
   (vlax-put-property xlCells "Item" row 2 (rtos leng 2 3))
   ;;;    (vlax-put-property xlCells "Item" row 2 (rtos leng 2 3)); for metric units  
   (setq sumlen (+ sumlen leng)))
   (setq row (1+ row))
   (vlax-put-property xlCells "Item" row 1 "SubTotal:")
   (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3))
   (setq total (+ total sumlen))
;;;    (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3)); for metric units
   (setq layer_list (cdr layer_list))
   (setq row (+ row 2))
   
 ) 
; footers:
(vlax-put-property xlCells "Item" row 1 "Total:")
(vlax-put-property xlCells "Item" row 2 (rtos total 2 3))
;;;(vlax-put-property xlCells "Item" row 2 (rtos total 2 3)); for metric units  
(mapcar (function (lambda(x)
     (vl-catch-all-apply
       (function (lambda()
     (progn
       (vlax-release-object x)
       (setq x nil)))))))
(list xlCells xlSheet xlSheets xlBook xlBooks xlApp)
)
(alert "Close Excel file manually")
(gc)(gc)
(princ)
 )
(princ "\t\t***\t  Type PLE to write polines length to Excel\t***")
(princ)

or this one extracts them to excel

 

(defun c:ple (/    layer layer_list leng row ss sumlen total xlApp xlCells)
 (vl-load-com)
 (if (setq ss (ssget "_X" (list (cons 0 "*POLYLINE"))))
   (progn
     (setq    xlApp (vlax-get-or-create-object "Excel.Application")
       xlCells       (vlax-get-property
                (vlax-get-property
                  (vlax-get-property
                (vlax-invoke-method
                  (vlax-get-property xlApp "Workbooks")
                  "Add")
                "Sheets")
                  "Item" 1)
                "Cells"))
     
     (vla-put-visible xlApp :vlax-true)
     (vlax-put-property xlCells "Item" 1 1 "Layer")
     (vlax-put-property xlCells "Item" 1 2 "Length")
     (setq row 2
       total 0)      
     (mapcar '(lambda (z)
        (if (not (member z layer_list))
          (setq layer_list (append (list z) layer_list))))
         (mapcar '(lambda (z) (cdr (assoc 8 (entget z)))) (mapcar 'cadr (ssnamex ss))))
     (repeat (length layer_list)
   (setq layer (car layer_list))
   (setq ss (ssget "_X" (list (cons 0 "*POLYLINE")(cons 8 layer))) sumlen 0)
   (mapcar '(lambda (z) (setq sumlen (+ sumlen (vla-get-length (vlax-ename->vla-object (cadr z)))))) (ssnamex ss))
   (vlax-put-property xlCells "Item" row 1 layer)
   (vlax-put-property xlCells "Item" row 2 (rtos sumlen 2 3))
   (setq total (+ total sumlen))
   (setq layer_list (cdr layer_list))
   (setq row (+ row 1))
   )
     (setq row (+ row 1))
     (vlax-put-property xlCells "Item" row 1 "Total:")
     (vlax-put-property xlCells "Item" row 2 (rtos total 2 3))
     
     (vlax-release-object xlApp)
     (alert "Close Excel file manually")
     (gc)(gc)
     (princ)
     ) (alert "There are no Polylines on your drawing!"))
 )

My 5 cents worth

That looks interesting, where can i get that from?

In the code i have, the ssget function is choosing all the entities.

The first instance of ssget makes a list of layers with polylines.

(setq ss (ssget "_X" (list (cons 0 "*POLYLINE"))) i -1)

If i remove "_X" it asks the user for selection, which is what i want.

The problem comes in later on in the script when it makes a new selection set to get measurements.

(setq ss (ssget "_X" (list (cons 0 "*POLYLINE")(cons 8 layer))) i -1 sumlen 0)

I would like it if these operations didnt take place on the selection set of all entities. Please help me change the above line so it performs the same function but on the selection set the user selected earlier.