TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: jav on August 30, 2007, 06:10:38 PM
-
Is there a routine out there anywhere that will list the total length of a group of lines that are on the same layer?
For example if we layout a bunch of pipe 3/4" dia. on one layer and more pipe, say 1 1/4", on another layer, it would be great if you could get the total length of pipe for each layer.
Thanks for any help.
-
Give this a try:
(defun c:totalen (/ total lay ss lst output)
(setq total 0
lay (cdr
(assoc
8
(entget
(car (entsel "\n Select object to set layer filter: "))
)
)
)
ss (ssget (list (cons '0 "LINE,*POLYLINE,SPLINE,ARC,CIRCLE")
(cons '8 lay)
)
)
)
(if (and lay ss)
(progn
(setq
lst (mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
)
(mapcar '(lambda (x)
(setq len (vlax-curve-getdistatparam
x
(vlax-curve-getendparam x)
)
total (+ total len)
)
)
lst
)
(setq output
(strcat "\n"
(itoa (sslength ss))
" objects on layer ''"
lay
"'' have a total length of - "
(rtos total (getvar 'lunits) 3)
)
)
(alert output)
(princ output)
)
)
)
-
Thanks very much ronjonp
-
You're welcome :-)
-
Count on all layers taking into account correction factor
(defun c:mlen (/ m ss clist temp)
(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" (cdar lst) " = " (rtos (* sum_len m) 2 4))
)
)
)
(vl-load-com)
(and
(if (null (setq m (getreal "\nEnter correction factor <1>:\t")))
(setq m 1) t)
(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\nTotal length by layer:"
)
(mapcar 'mlen3_1 clist)
)
(princ)
) ;_ defun