calculate the area of the hatchs

trezatreza · ‎11-20-2020

Hi all,

Please can you help me, I want to calculate the area of the hatchs, And it gives me in the command window (As the attached picture)

Thank you so much in advance

Sea-Haven · ‎11-20-2020

This is a quick 1 does 1 hatch layer at a time

(Defun C:AHAT (/ arean  lay sset)
(setvar 'ctab "Model")
(setq Hp (ENTGET (CAR (ENTSEL "\nPICK HATCH "))))
(SETQ LAY (CDR (ASSOC 8 HP)))
(setq ssEt (ssget "x" (list (cons 0 "Hatch") (CONS 8 LAY)(cons 410 "Model"))))
(setq arean 0.0)
(REPEAT (setq num (sslength sset))
(setq en (ssname sset (setq num (- num 1))))
(SETQ ARNEW (vla-get-area (vlax-ename->vla-object en)))
(setq AREAN (+ AREAN ARNEW))
)
(ALERT (STRCAT (rtos (sslength sset) 2 0) " Segments\n\n" "Layer is " lay "\n\n Area is  "  (RTOS AREAN 2 2)))
(princ)
)

ronjonp · ‎11-20-2020

Here's a quick one:

(defun c:foo (/ _a a b l r s)
  ;; RJP » 2020-11-20
  (defun _a (o / r)
    (cond ((= 'real (type (setq r (vl-catch-all-apply 'vla-get-area (list o))))) r)
	  ;; ((= 'real (type (setq r (vl-catch-all-apply 'vlax-curve-getarea (list o))))) r)
    )
  )
  (if (setq s (ssget '((0 . "HATCH"))))
    (progn (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	     (setq l (cdr (assoc 8 (entget e))))
	     (if (setq a (_a (vlax-ename->vla-object e)))
	       (if (setq b (assoc l r))
		 (setq r (subst (cons l (+ (cdr b) a)) b r))
		 (setq r (cons (cons l a) r))
	       )
	       (print "Hatch does not have area!!")
	     )
	   )
	   (mapcar 'print (vl-sort r '(lambda (r j) (< (car r) (car j)))))
    )
  )
  (princ)
)

trezatreza · ‎11-21-2020

Thanks for the responses

Please sir can you amend it :
1-remove the sign ( and "
2-That only two numbers appear after the comma (decimals)
3-Add total areas
(as pictured)

pbejse · ‎11-21-2020

@trezatreza wrote:

(as pictured)

(as coded)

(defun C:Shoes ( / ss i e OArea data lay) 
  (if (setq ss (ssget '((0 . "HATCH"))))
	    (progn
	    	(repeat (setq i (sslength ss))
		  (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
		  	(if (not (vl-catch-all-error-p
				   (setq OArea (vl-catch-all-apply 'vla-get-area (list e)))))
			  (setq data
			  	(if (setq f (assoc (setq lay (vla-get-layer e)) data))
				  	(subst (cons lay (+ (Cdr f) OArea)) f data)
				  	(cons (cons lay OArea) data)))
				 )
			  )    
	      (foreach itm (append data (list (cons "Total Area..." (apply '+ (mapcar 'cdr data)))))
		(princ (strcat "\n" (Car itm) "......" (rtos (cdr itm) 2 2))))
	    )
      )
(princ)
    )

HTH

trezatreza · ‎11-21-2020

Thank you very much, please change one last.
I added the code (prince "\ n ------------------------------------ in order to separate "total area" from the rest of "layer"
But also the layers are separate

(defun C:Shoes ( / ss i e OArea data lay) 
  (if (setq ss (ssget '((0 . "HATCH"))))
	    (progn
	    	(repeat (setq i (sslength ss))
		  (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
		  	(if (not (vl-catch-all-error-p
				   (setq OArea (vl-catch-all-apply 'vla-get-area (list e)))))
			  (setq data
			  	(if (setq f (assoc (setq lay (vla-get-layer e)) data))
				  	(subst (cons lay (+ (Cdr f) OArea)) f data)
				  	(cons (cons lay OArea) data)))
				 )
			  )    
	      (foreach itm (append data (list (cons "Total Area..." (apply '+ (mapcar 'cdr data)))))
                         (princ "\n------------------------------------")
		(princ (strcat "\n" (Car itm) "......" (rtos (cdr itm) 2 2))))
	    )
      )
(princ)
    )

pbejse · ‎11-21-2020

@trezatreza wrote:

But also the layers are separate

(defun C:Shoes ( / PadRight ss i e OArea data lay)
(defun PadRight	(s1 s2 n c / str_)
  ((lambda (s1 s2)
     (repeat (- n (+ (strlen s1) (strlen s2)))
       (setq s1 (strcat s1 c))
     )(strcat "\n" s1 s2)
   )
    (strcat s1 "") (strcat "" s2)
  )
)
  (if (setq ss (ssget '((0 . "HATCH"))))
	    (progn
	    	(repeat (setq i (sslength ss))
		  (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
		  	(if (not (vl-catch-all-error-p
				   (setq OArea (vl-catch-all-apply 'vla-get-area (list e)))))
			  (setq data
			  	(if (setq f (assoc (setq lay (vla-get-layer e)) data))
				  	(subst (cons lay (+ (Cdr f) OArea)) f data)
				  	(cons (cons lay OArea) data)))
				 )
			  )    
	      (foreach itm data
		(princ (strcat (PadRight (Car itm)  (rtos (cdr itm) 2 2) 50 "."))))	     
	        (princ (strcat "\n--------------------------------------------------"
			(PadRight  "Total Area" (rtos (apply '+ (mapcar 'cdr data)) 2 2) 50 "."
				 )))
	    )
      )
(princ)
    )

Command:  SHOES
Select objects: Specify opposite corner: 5 found
Select objects:
A-WALL-FULL-EXTR.............................22.91
A-AREA-OTLN.................................886.05
TRI_Space Class............................1288.60
--------------------------------------------------
Total Area.................................1553.27

trezatreza · ‎11-21-2020

Please 🙏 🙏🙏 i want to change from 50 "." To “......” but it didn't work for me

(defun C:Shoes ( / PadRight ss i e OArea data lay)
(defun PadRight	(s1 s2 n c / str_)
  ((lambda (s1 s2)
     (repeat (- n (+ (strlen s1) (strlen s2)))
       (setq s1 (strcat s1 c))
     )(strcat "\n" s1 s2)
   )
    (strcat s1 "") (strcat "" s2)
  )
)
  (if (setq ss (ssget '((0 . "HATCH"))))
	    (progn
	    	(repeat (setq i (sslength ss))
		  (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
		  	(if (not (vl-catch-all-error-p
				   (setq OArea (vl-catch-all-apply 'vla-get-area (list e)))))
			  (setq data
			  	(if (setq f (assoc (setq lay (vla-get-layer e)) data))
				  	(subst (cons lay (+ (Cdr f) OArea)) f data)
				  	(cons (cons lay OArea) data)))
				 )
			  )    
	      (foreach itm data
		(princ (strcat (PadRight (Car itm) "..........."  (rtos (cdr itm) 2 2)))))	     
	        (princ (strcat "\n--------------------------------------------------"
			(PadRight  "Total Area.........." (rtos (apply '+ (mapcar 'cdr data)) 2 2)
				 )))
	    )
      )
(princ)
    )

pbejse · ‎11-21-2020

@trezatreza wrote:

Please 🙏 🙏🙏 i want to change from 50 "." To “......” but it didn't work for me

50 is the total length of the string

_$ (strlen "Total Area.................................1553.27")
50

Change 50 to a smaller number if you want shorter lines. Here's what 30 look like

A-WALL-FULL-EXTR.........22.91
A-AREA-OTLN.............886.05
TRI_Space Class........1288.60
--------------------------------------------------
Total Area.............1553.27

trezatreza · ‎11-22-2020

Because if the layer name is long, the letters are attached to the numbers

pbejse · ‎11-22-2020

This

(foreach itm (append data (list (cons "Total Area..." (apply '+ (mapcar 'cdr data)))))
(princ (strcat "\n" (Car itm) "......" (rtos (cdr itm) 2 2))))

to

(foreach itm data
(princ (strcat "\n" (Car itm) "......" (rtos (cdr itm) 2 2))))
(princ "\n------------------------------------")
(princ (strcat "\nTotal Area........." (rtos (apply '+ (mapcar 'cdr data)) 2 2)))

HTH

ronjonp · ‎11-22-2020

Here's another with prettier print results:

(defun c:foo (/ _a _pad a b l m r s x)
  ;; RJP » 2020-11-22
  (defun _a (o / r)
    (cond ((= 'real (type (setq r (vl-catch-all-apply 'vla-get-area (list o))))) r)
	  ;; ((= 'real (type (setq r (vl-catch-all-apply 'vlax-curve-getarea (list o))))) r)
    )
  )
  (defun _pad (s n) (repeat n (setq s (strcat s "."))) (strcat s " "))
  (if (setq s (ssget '((0 . "HATCH"))))
    (progn (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	     (setq l (cdr (assoc 8 (entget e))))
	     (if (setq a (_a (vlax-ename->vla-object e)))
	       (if (setq b (assoc l r))
		 (setq r (subst (cons l (+ (cdr b) a)) b r))
		 (setq r (cons (cons l a) r))
	       )
	       (print "Hatch does not have area!!")
	     )
	   )
	   (setq m (+ 10 (apply 'max (mapcar 'strlen (mapcar 'car r)))))
	   (foreach x (append (vl-sort r '(lambda (r j) (< (car r) (car j))))
			      (list (cons "Total Area:" (apply '+ (mapcar 'cdr r))))
		      )
	     (princ (strcat "\n" (_pad (car x) (- m (strlen (car x)))) (rtos (cdr x) 2 2)))
	   )
    )
  )
  (princ)
)

Print to command line:

FOO
Select objects: Specify opposite corner: 15 found
Select objects:
0............... 3.32
Lay2............ 13.26
Layer1.......... 6.63
Layer3.......... 26.53
Total Area:..... 49.74

Community

calculate the area of the hatchs

calculate the area of the hatchs

calculate the area of the hatchs