(defun c:SAL (/ m ss clist temp)
;;command SAL - Sum Area by Layer
;;posted Vladimir Azarko (VVA)
;;http://www.cadtutor.net/forum/showthread.php?t=28604
(defun sort (lst predicate)
(mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst predicate))
) ;_ end of defun
(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))
) ;_ end of progn
) ;_ end of if
) ;_ end of foreach
(cons current result)
) ;_ end of defun
(defun marea (lst / sum_len)
(setq sum_len 0)
(foreach item (mapcar 'car lst)
(setq
sum_len (+ sum_len
(if (vlax-property-available-p item 'Area)
(vla-get-area item)
) ;_ if
) ;_ +
) ;_ end of setq
) ;_ end of foreach
(if (not (zerop sum_len))
(princ
(strcat "\n\t" (cdar lst) " = " (rtos (* sum_len m) 2 4))
) ;_ end of princ
) ;_ end of if
) ;_ end of defun
(vl-load-com)
(if (null *M*)
(setq *M* 1)
) ;_ end of if
(initget 6)
(and
(princ "\nEnter scale factor : ")
(or (setq m (getreal)) (setq m *M*))
(setq *M* m)
(setq ss (ssget '((0 . "*POLYLINE,SPLINE,CIRCLE,ELLIPSE"))))
(setq ss (mapcar
(function vlax-ename->vla-object)
(vl-remove-if
(function listp)
(mapcar
(function cadr)
(ssnamex ss)
) ;_ mapcar
) ;_ vl-remove-if
) ;_ end of mapcar
) ;_ end of setq
(mapcar '(lambda (x)
(setq temp (cons (cons x (vla-get-layer x)) temp))
) ;_ end of lambda
ss
) ;_ end of mapcar
(setq clist (combine temp
'(lambda (a b)
(> (cdr a) (cdr b))
) ;_ end of lambda
'(lambda (a b)
(eq (cdr a) (cdr b))
) ;_ end of lambda
) ;_ end of combine
) ;_ end of setq
(princ
"\n\n Total area by layer :"
) ;_ end of princ
(mapcar 'marea clist)
) ;_ end of and
(princ)
) ;_ defun

Advertisements