i have multi hatch in drawing how to get batch area?

[afrazawan]

i have multi hatch in drawing how to get batch area?

suppose i have all hatch in separate layer each hatch have separate layer so i need to find out area by layer each layer separate please any lisp

[ReMark]

You don't need a lisp routine just use the DATAEXTRACTION command.

 

Simple test. Four hatched objects (2 on each layer). Layer names are "0" and "Layer1".

 

 

I assume you are smart enough to do the required math.

[Pablo Ferral]

or

Select all four hatches and look in the properties palette.

or

Use the LIST command and add them up.

[ReMark]

For a small number of hatches then the above two methods might be worth using but for a larger number of hatches spread across multiple layers I think DATAEXTRACTION would be a better choice.

 

I've looked for a lisp routine that will spit out the total area of hatches on multiple layers but I have not found one. I will continue to look as time permits.

[afrazawan]

im looking for any LISP please

[satishrajdev]

hi afrazawan......

 

try this one, i hope this could help you

 

(defun c:HA (/ sset i area obj)
 (if (>= (atof (substr (getvar "acadver") 1 4)) 16.2)
   (progn
     (prompt "\nSelect hatches: ")
     (if (setq sset (ssget '((0 . "hatch"))))
(progn
  (setq
    i	 (1- (sslength sset))
    area 0
  )
  (while (>= i 0)
    (setq
      obj   (vlax-ename->vla-object (ssname sset i))
      area  (+ area (vla-get-area obj))
      lname (cdr (assoc 8 (entget (ssname sset i))))
    )
    (setq i (1- i))
  )
  (alert
    (strcat
      "\nTotal Area = "
      (if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4))
	(strcat
	  (rtos area 2)
	  " sq. in. ("
	  (rtos (/ area 144) 2)
	  " sq. ft.)"
	)
	(rtos area)
      )
      "\nLayer Name = "
      (strcat lname)
    )
  )
)
     )
   )
 )
 (princ
   (strcat
     "\nTotal area = "
     (if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4))
(strcat
  (rtos area 2)
  " sq. in. ("
  (rtos (/ area 144) 2)
  " sq. ft.)"
)
(rtos area)
     )
     "\nLayer Name = "
     (strcat lname)
   )
 )
 (princ)
)

[SLW210]

im looking for any LISP please

 

If you want a LISP, why not ask in AutoLISP, Visual LISP & DCL forum?

 

I moved your thread.

[marko_ribar]

(defun c:hatchareabylayers ( / ss i h l a x )

 (vl-load-com)

 (if (setq ss (ssget '((0 . "HATCH"))))
   (progn
     (setq i -1)
     (while (setq h (ssname ss (setq i (1+ i))))
       (setq l (cdr (assoc 8 (entget h))))
       (setq a (vla-get-area (vlax-ename->vla-object h)))
       (if (assoc l x)
         (setq x (subst (cons l (+ a (cdr (assoc l x)))) (assoc l x) x))
         (setq x (cons (cons l a) x))
       )
     )
     (foreach e x
       (prompt "\nTotal hatches areas of <\"") (princ (car e)) (prompt "\"> are : ") (princ (rtos (cdr e)))
     )
   )
   (prompt "\nNo valid selection set of hatches - repeat action again with : Command: habl !")
 )
 (princ)
)

(defun c:habl nil (c:hatchareabylayers))
(prompt "Invoke with : habl")
(princ)

 

M.R.

[asos2000]

hatch which has no area should be consider

;|------------ Decucted Area  ------------------
    q_|_|| _\|| q_|| _\|		
					
 Lisp to calulate hatch area and change	
 the layer and color for hatch which has	
 no area					
 						
------------------------------------------------
 Author: Hasan M. Asous, 2013			
ALL RIGHT RESERVED TO ALL		
 Contact: HasanCAD @ TheSwamp.org,		
          asos2000 @ CADTutor.net		
          HasanCAD@gmail.com			
------------------------------------------------
 Ver. : 1.0  2013 05 16  First issue		
 			  			
________________________________________________
				      |;


;     q_|_|| _\|| q_|| _\|     ;
;       Subroutine Start       ;

(defun NLayer (Nme clr)
 (if (not (tblsearch "LAYER" Nme))
   (progn
     (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord")
	     (cons 100 "AcDbLayerTableRecord") (cons 2  Nme)
	     (cons 70 0) (cons 62 clr))))))

;     q_|_|| _\|| q_|| _\|     ;
;        Subroutine End        ;

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;

(defun c:HArea (/ AREA CNT OBJ OBJVL ORC SSET )
 (nlayer "HatchHasNoArea" 1)
 
 (if (>= (atof (substr (getvar "acadver") 1 4)) 16.2)
   (progn
     (prompt "\nSelect hatches: ")
     (if (and (setq sset (ssget '((0 . "hatch"))) cnt 0 area 0))
(progn
  (repeat (sslength sset)
    (setq obj   (ssname sset cnt))
    (setq objvl (vlax-ename->vla-object obj))
    (if (vl-catch-all-error-p
	  (vl-catch-all-apply 'vla-get-area (list objvl)))
      (progn
	(vla-put-color objvl 256)
	(vla-put-layer objvl "HatchHasNoArea")
	) ;prgn
      (setq area (+ area (vla-get-area objvl)))
      ) ;if
    (setq cnt (1+ cnt))
    ) ; repeat
  )
) ;if
     )) ; if
 (alert
   (strcat
     "\nTotal area = "
     (if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4))
(strcat (rtos area 2) " sq. in. (" (rtos (/ area 144) 2) " sq. ft.)"
	"\nHatchs with RED color DID NOT calculated\nand moved to new layer")
(strcat (rtos area) "\nHatchs with RED color DID NOT calculated\nand moved to new layer"))
     ) ; strcat
   ) ;alert
 ) ; defun

(vl-load-com) (princ "\nType  HAREA  to Invoke the program")

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine End        ;

[BlackBox]

Not all Hatch Objects have a valid Area Property (i.e., some custom patterns, etc.)... Why not extract hatch boundary loop(s) and then extract resultant area calculation(s)?

Edited July 15, 2013 by BlackBox

[ptatohed]

Area command - A for Add - O for Object -

 

Or like PF mentioned, select them, then read the 'Cumulative Area' in the Properties box.

[G123]

Ideas and lisps above are really good, but I was wondering is there an upgraded version of this idea where you get the sum of areas of the certain layer hatches by one click (I mean easily with the help of lisp). For example I have 20 hatches in different locations (in same drawing) under layer "grass" and 10 hatches under layer "asphalt". When I pick a hatch under layer "grass" all areas are calculated into a sum. So, the cumulative area of hatches sorted by layer. When the drawing is small, there is no problem to click one by one or select similar, but when there are many hatches - hatch areas sum by layer would be very helpful. Wondering, is anything like this possible or is it too complicated

[exceed]

9 hours ago, G123 said:

위의 아이디어와 lisp는 정말 좋지만 클릭 한 번으로 특정 레이어 해치의 면적 합계를 얻을 수 있는 이 아이디어의 업그레이드 버전이 있는지 궁금합니다(lisp의 도움으로 쉽게 의미합니다). 예를 들어 "잔디" 레이어 아래 다른 위치(동일한 도면)에 20개의 해치가 있고 "아스팔트" 레이어 아래에 10개의 해치가 있습니다. "잔디" 레이어에서 해치를 선택하면 모든 영역이 합계로 계산됩니다. 따라서 레이어별로 정렬된 해치의 누적 영역입니다. 도면이 작을 때는 하나씩 클릭하거나 비슷한 것을 선택하는 데 문제가 없지만, 해치가 많을 때는 해치 영역을 레이어별로 합하면 큰 도움이 됩니다. 이런게 가능한건지 너무 복잡한건지 궁금합니다

 

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-table-with-hatched-areas-by-layer-name/td-p/9991394

 

you mean this?

[Dadgad]

As you have the hatches on different layers...Grass & Asphalt, for example;

you can use the LAYISO command to isolate (one layer at a time).  SELECTALL, then look at Properties.

Not a lisp, but pretty quick, and spares you selecting manually.

Then use LAYUNISO to restore all layers, and LAYISO again for whichever other hatch layer you want to check.   Old school.

Edited March 16, 2022 by Dadgad
typo

[BIGAL]

Like Dadgad isolate layers then a ssget of hatches the this  lisp, thanks to ronjonp over at the swamp.

 

; area of hatches, use layiso to isolate hatch name could be layer etc 
: By AlanH Mar 2022

; Thanks to ronjonp for area answer
http://www.theswamp.org/index.php?action=post;topic=57439.0;last_msg=609227

(vl-load-com)

(defun areahat (l / k n r)
  (setq l (vl-sort l '(lambda (r j) (> (car r) (car j)))))
  (while (setq k (car l))
    (setq l (cdr l)
          n (cadr k)
          k (car k)
    )
    (while (= k (caar l)) (setq n (+ n (cadr (car l)))) (setq l (cdr l)))
    (setq r (cons (list k n) r))
  )
)


(defun c:Totareahat ( / ss lst x obj areah nameh) 
(setq ss (ssget '((0 . "HATCH"))))
(if (= ss nil)
(princ "\nno hatches selected")
(progn
(setq lst '())
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq areah (vlax-get obj 'area))
(setq nameh (vlax-get obj 'PatternName))
(setq lst (cons (list nameh areah) lst))
)
)
)

(setq arealst (areahat lst))

(princ)
)