Default lisp to calculate total areas


لو عندي مجموعة مربعات وعايز احسب مساحاتهم كلهم


ياترى فيه ليسب يعمل الكلام دا














http://www.jtbworld.com/lisp/aream.htm



;;; AREAM.LSP
;;; Function: Calculates the total area of selected objects
;;; By Jimmy Bergmark
;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved
;;; Website: www.jtbworld.com
;;; E-mail: info@jtbworld.com
;;; Tested on AutoCAD 2000

(defun c:aream (/ olderr oldcmdecho errexit undox restore ss1 nr en tot_area)
(defun errexit (s)
(restore)
)

(defun undox ()
(command "._undo" "_E")
(setvar "cmdecho" oldcmdecho)
(setq *error* olderr)
(princ)
)

(setq olderr *error*
restore undox
*error* errexit
)
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "._UNDO" "_BE")
(if (setq ss1 (ssget '((-4 . "<OR")
(0 . "POLYLINE")
(0 . "LWPOLYLINE")
(0 . "CIRCLE")
(0 . "ELLIPSE")
(0 . "SPLINE")
(0 . "REGION")
(-4 . "OR>")
)
)
)
(progn
(setq nr 0)
(setq tot_area 0.0)
(setq en (ssname ss1 nr))
(while en
(command "._area" "_O" en)
(setq tot_area (+ tot_area (getvar "area")))
(setq nr (1+ nr))
(setq en (ssname ss1 nr))
)
(princ "\nTotal Area = ")
(princ tot_area)
)
)
(setq ss1 nil)
(restore)
)




-or

(defun c:sarea(/ aSum cSet cSet)
(vl-load-com)
(setq aSum 0)
(if
(setq cSet
(ssget '((0 . "*POLYLINE,SPLINE,CIRCLE,ELLIPSE"))))
(progn
(foreach c(vl-remove-if 'listp
(mapcar 'cadr(ssnamex cSet)))
(if(vlax-curve-IsClosed c)
(setq aSum(+ aSum(vlax-curve-GetArea c)))
(ssdel c cSet)
); end if
); end foreach
(princ(strcat "\nTotal area = " (rtos aSum)))
(sssetfirst nil cSet)
); end progn
); end if
(princ)
); end of c:sarea


-or

(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)

تعليقات

المشاركات الشائعة