Quantcast
Channel: BIMarabia
Viewing all articles
Browse latest Browse all 8760

Default lisp to calculate total areas

$
0
0

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

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

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

Viewing all articles
Browse latest Browse all 8760

Trending Articles