window.location = "http://bimarabia.com/os"; Related Posts Plugin for WordPress, Blogger...

الاثنين، 20 أكتوبر، 2014

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)

ليست هناك تعليقات :

إرسال تعليق

BIM arabia © 2014. All Rights Reserved | Powered by- Blogger

Designed by- Dapinder