Lisps to calculate total area of only Hatches/ of Hatches AND other Objects

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello everybody,
last time I needed to calculate total area of some objects. I found Lee Mac's "TAREA" lisp here:
http://www.lee-mac.com/totallengthandarea.html
It is great!
But, it doesn't work for Hatch Patterns.
I wanted to have two additional lisps:
1. Lisp which calculates cumulative (total) area of selected objects, which are ONLY Hatches
2. Lisp which calculates cumulative (total) area of selected objects, which are Polylines, Circles, etc. AND Hatches
The lisp number 1. I called TAREAH, and The lisp number 2. I called TAREADW.
So I modified your TAREA lisp and I got two new lisps which I wanted, that means "TAREAH" and "TAREADW".
Here are thtse lisps:
"TAREADW"
http://www.lee-mac.com/totallengthandarea.html
;;---------------------=={ Total Area }==---------------------;; ;; ;; ;; Displays the total area of selected objects at the ;; ;; command line. The precision of the printed result is ;; ;; dependent on the setting of the LUPREC system variable. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;; ;;------------------------------------------------------------;; (defun c:tareaDW ( / a i s ) (if (setq s (ssget '( (0 . "CIRCLE,ELLIPSE,*POLYLINE,SPLINE,HATCH") ; "HATCH" - Addad by DW (-4 . "<NOT") (-4 . "<AND") (0 . "POLYLINE") (-4 . "&") (70 . 80) (-4 . "AND>") (-4 . "NOT>") ) ) ) (progn (setq a 0.0) (repeat (setq i (sslength s)) (setq a (+ a (vlax-curve-getarea (ssname s (setq i (1- i)))))) ) (princ "\nTotal Area: ") (princ (rtos a 2)) ) ) (princ) ) (vl-load-com) (princ)
"TAREAH"
; http://www.lee-mac.com/totallengthandarea.html ;;---------------------=={ Total Area }==---------------------;; ;; ;; ;; Displays the total area of selected objects at the ;; ;; command line. The precision of the printed result is ;; ;; dependent on the setting of the LUPREC system variable. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;; ;;------------------------------------------------------------;; (defun c:tareaH ( / a i s ) (if (setq s (ssget '( 0 . "HATCH" ) ) ) (progn (setq a 0.0) (repeat (setq i (sslength s)) (setq a (+ a (vlax-curve-getarea (ssname s (setq i (1- i)))))) ) (princ "\nTotal Area: ") (princ (rtos a 2)) ) ) (princ) ) (vl-load-com) (princ)
Please, if you could, tell me what I made wrong and why they don't work properly.