Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Lisp routine that will add up the lengths of all lines, arcs and polylines in

3 REPLIES 3
Reply
Message 1 of 4
Anonymous
2977 Views, 3 Replies

Lisp routine that will add up the lengths of all lines, arcs and polylines in

Hello Everybody,

I need a lisp routine that will add up the lengths of all
lines, arcs and polylines in a given layer.

Any ideas?

Thanks, Steve (Win98, A2K)
3 REPLIES 3
Message 2 of 4
Anonymous
in reply to: Anonymous

Steve,

Below the content of an earlier posting from Jaysen Long (Date: 21-09-1999,
Subject: Total length of selected lines)

Alex


LL sums the length of all objects on selected layers.
OBL sums the length of selected objects.

Both print the output to the command line giving the lengths for different
layers as well as a total.


(defun c:ll ( / ) (ll:output "X" "\nSelect objects on layers to total...")
(princ))
(defun c:obl ( / ) (ll:output "P" "\nSelect objects to total...") (princ))


(defun ll:output (ll:sstype ll:prompt / ll:ss i ll:ename ll:elist ll:layer
ll:layerlist ll:totallength
ll:layerlength ll:arcdelta
ll:objlength ll:space)
(prompt "\nLayer Lengths by Jaysen D. Long\nCopyright \2511998-1999. All
Rights Reserved.")
(setq ll:layerlist nil)
(prompt ll:prompt)
(if (setq ll:ss (ssget '((0 .
"ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,REGION,SPLINE"))))
(progn
(repeat (setq i (sslength ll:ss))
(setq ll:elist (entget (ssname ll:ss (setq i (1- i)))))
(if (not (member (setq ll:layer (cdr (assoc 8 ll:elist)))
ll:layerlist))
(setq ll:layerlist (append ll:layerlist (list ll:layer)))
)
)
(setq ll:totallength 0.0)
(foreach x ll:layerlist
(setq ll:layerlength 0.0)
(command "._select" ll:ss "")
(setq ll:ss (ssget ll:sstype (list (cons 0
"ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,REGION,SPLINE") (cons 8 x))))
(repeat (setq i (sslength ll:ss))
(setq ll:ename (ssname ll:ss (setq i (1- i))))
(setq ll:elist (entget ll:ename))
(cond
( (eq (cdr (assoc 0 ll:elist)) "ARC")
(if (> (cdr (assoc 50 ll:elist)) (cdr (assoc 51 ll:elist)))
(setq ll:arcdelta (+ (abs (- (cdr (assoc 50 ll:elist)) (*
2.0 pi))) (cdr (assoc 51 ll:elist))))
(setq ll:arcdelta (- (cdr (assoc 51 ll:elist)) (cdr (assoc
50 ll:elist))))
)
(setq ll:objlength (* (cdr (assoc 40 ll:elist)) ll:arcdelta))
)
( (eq (cdr (assoc 0 ll:elist)) "LINE")
(setq ll:objlength (distance (cdr (assoc 10 ll:elist)) (cdr
(assoc 11 ll:elist))))
)
( (wcmatch (cdr (assoc 0 ll:elist))
"*POLYLINE,CIRCLE,ELLIPSE,REGION,SPLINE")
(command "._area" "_obj" ll:ename)
(setq ll:objlength (getvar "perimeter"))
)
)
(setq ll:layerlength (+ ll:layerlength ll:objlength))
)
(setq ll:space "" ll:prompt (strcat x ": " (rtos ll:layerlength 2 2)
" LF"))
(prompt (strcat "\n" x ": " (repeat (- 52 (strlen ll:prompt)) (setq
ll:space (strcat ll:space " "))) (rtos ll:layerlength 2 2) " LF"))
(setq ll:totallength (+ ll:totallength ll:layerlength))
)
(setq ll:space "" ll:prompt (strcat "Total: " (rtos ll:totallength 2
2) " LF"))
(prompt (strcat "\nTotal: " (repeat (- 52 (strlen ll:prompt)) (setq
ll:space (strcat ll:space " "))) (rtos ll:totallength 2 2) " LF"))
)
)
)


Jaysen


Message 3 of 4
Anonymous
in reply to: Anonymous

I did this one with the help of newsgroups, so, thanks everyone..
Message 4 of 4
Anonymous
in reply to: Anonymous

Thanks a lot! I appreciate it.

Steve


"Alex Repetto" wrote in message
news:C58F2DE457B9D03E14AB6C1537968A4D@in.WebX.maYIadrTaRb...
> Steve,
>
> Below the content of an earlier posting from Jaysen Long (Date:
21-09-1999,
> Subject: Total length of selected lines)
>
> Alex
>
>
> LL sums the length of all objects on selected layers.
> OBL sums the length of selected objects.
>
> Both print the output to the command line giving the lengths for different
> layers as well as a total.
>
>
> (defun c:ll ( / ) (ll:output "X" "\nSelect objects on layers to total...")
> (princ))
> (defun c:obl ( / ) (ll:output "P" "\nSelect objects to total...") (princ))
>
>
> (defun ll:output (ll:sstype ll:prompt / ll:ss i ll:ename ll:elist ll:layer
> ll:layerlist ll:totallength
> ll:layerlength ll:arcdelta
> ll:objlength ll:space)
> (prompt "\nLayer Lengths by Jaysen D. Long\nCopyright \2511998-1999. All
> Rights Reserved.")
> (setq ll:layerlist nil)
> (prompt ll:prompt)
> (if (setq ll:ss (ssget '((0 .
> "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,REGION,SPLINE"))))
> (progn
> (repeat (setq i (sslength ll:ss))
> (setq ll:elist (entget (ssname ll:ss (setq i (1- i)))))
> (if (not (member (setq ll:layer (cdr (assoc 8 ll:elist)))
> ll:layerlist))
> (setq ll:layerlist (append ll:layerlist (list ll:layer)))
> )
> )
> (setq ll:totallength 0.0)
> (foreach x ll:layerlist
> (setq ll:layerlength 0.0)
> (command "._select" ll:ss "")
> (setq ll:ss (ssget ll:sstype (list (cons 0
> "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,REGION,SPLINE") (cons 8 x))))
> (repeat (setq i (sslength ll:ss))
> (setq ll:ename (ssname ll:ss (setq i (1- i))))
> (setq ll:elist (entget ll:ename))
> (cond
> ( (eq (cdr (assoc 0 ll:elist)) "ARC")
> (if (> (cdr (assoc 50 ll:elist)) (cdr (assoc 51 ll:elist)))
> (setq ll:arcdelta (+ (abs (- (cdr (assoc 50 ll:elist)) (*
> 2.0 pi))) (cdr (assoc 51 ll:elist))))
> (setq ll:arcdelta (- (cdr (assoc 51 ll:elist)) (cdr (assoc
> 50 ll:elist))))
> )
> (setq ll:objlength (* (cdr (assoc 40 ll:elist))
ll:arcdelta))
> )
> ( (eq (cdr (assoc 0 ll:elist)) "LINE")
> (setq ll:objlength (distance (cdr (assoc 10 ll:elist)) (cdr
> (assoc 11 ll:elist))))
> )
> ( (wcmatch (cdr (assoc 0 ll:elist))
> "*POLYLINE,CIRCLE,ELLIPSE,REGION,SPLINE")
> (command "._area" "_obj" ll:ename)
> (setq ll:objlength (getvar "perimeter"))
> )
> )
> (setq ll:layerlength (+ ll:layerlength ll:objlength))
> )
> (setq ll:space "" ll:prompt (strcat x ": " (rtos ll:layerlength 2
2)
> " LF"))
> (prompt (strcat "\n" x ": " (repeat (- 52 (strlen ll:prompt))
(setq
> ll:space (strcat ll:space " "))) (rtos ll:layerlength 2 2) " LF"))
> (setq ll:totallength (+ ll:totallength ll:layerlength))
> )
> (setq ll:space "" ll:prompt (strcat "Total: " (rtos ll:totallength 2
> 2) " LF"))
> (prompt (strcat "\nTotal: " (repeat (- 52 (strlen ll:prompt)) (setq
> ll:space (strcat ll:space " "))) (rtos ll:totallength 2 2) " LF"))
> )
> )
> )
>
>
> Jaysen
>
>
>

>
>
>

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost