لو عندي مجموعة مربعات وعايز احسب مساحاتهم كلهم
ياترى فيه ليسب يعمل الكلام دا
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)
Filed under: autolisp
