Find the total sum of hatch areas for different layers

February 16

Hi, I need help with lisp code and I would be very grateful if you could give me a solution. I have a cross section and I want to find the total sum of each layer's total hatch area values and write the result on the drawing. For example at "wearing" layer there are 6 hatched objects and I want to find the total sum of hatched objects at wearing layer . And similar calculation on binder, bitumen ,base and subbase layers.

I have a code and it works without diffent layer condition , I need to insert the layer condition

defun C:h11 () (hatcharea))
(defun hatcharea ( / ss area i eo pt) 
(setq
    ss (ssget '((0 . "hatch")))
    area 0
    i 0
)
(cond 
    ((and(and ss) (> (sslength ss) 0))
        (repeat (sslength ss)
        (setq eo (vlax-ename->vla-object (ssname ss i)))
        (setq area (+ area (vlax-get eo 'Area)))
        (setq i (+ i 1))
        )
        (while (not pt)(setq pt (getpoint "\nSelect area text insertion point >")))
        (command "color" "bylayer")
        (command "STYLE" "Standard" "" 2 "" "" "" "")
        (command "text" pt 0 (strcat "Area = " (rtos area 2 2)) "")
        (command "STYLE" "Standard" "" 0.2 "" "" "" "")
    )
)
(princ)
)

sample_km.dwg

Edited February 16 by SLW210
Added Code Tags!!

February 16

Written from my smartphone.
I haven't tried it but it should work.

(defun hatcharea (/ ss area i eo pt lst layer lstLayers)
  (setq
    ss	 (ssget '((0 . "hatch")))
    area 0
    i	 0
  )
  (cond
    ((and (and ss) (> (sslength ss) 0))
     (repeat (sslength ss)
       (setq eo (vlax-ename->vla-object (ssname ss i)))
       (setq area (vlax-get eo 'Area)
	     layer (vlax-get-property eo "LAYER")
       )
       (if (setq lst (assoc layer lstLayers))
	 (setq lstLayers (subst (list layer (+ (cadr lst) area)) lst lstLayers))
	 (setq lstLayers (append lstLayers (list (list layer area))))
       )
       (setq i (+ i 1))
     )
     (foreach layer lstLayers
       (if (setq pt (getpoint (strcat "\nInsertion point for area HATCHs in layer \'" (strcase (car layer)) "\'")))
	 (progn
	   (setq area (cadr layer))
           (command "color" "bylayer")
           (command "STYLE" "Standard" "" 2 "" "" "" "")
           (command "text" pt 0 (strcat "Area = " (rtos area 2 2)) "")
           (command "STYLE" "Standard" "" 0.2 "" "" "" "")
	 )
       )
     )
    )
  )
  (princ)
)

February 16

Please use Code Tags for your code in the future. (<> in the editor toolbar)

February 16

As your talking a road crossection and it looks to me that the road crossection has been made by software, so my comment is why does the software not produce a report for every crossection breaking down each material ?

For me I use Civil Site Design and it produces a report for the entire road length summarising all material used and last a grand total.

February 19

On 2/16/2025 at 9:37 PM, GLAVCVS said:
Written from my smartphone.
I haven't tried it but it should work.
(defun hatcharea (/ ss area i eo pt lst layer lstLayers)
 (setq
 ss (ssget '((0 . "hatch")))
 area 0
................

This code works well. Is it possible to insert text of the same color (or layer)
into the code that's what the hatching is.

February 19

Simply:
On the line before '(foreach layer lstLayers... ' write

(if (= 
      (cdr (assoc 62 (tblsearch "layer" (getvar "CLAYER")))) 
      (setq color (vlax-get-property eo "layer"))
    )
  (setq color " bylayer")
)

And then, on the line:

'(command "color" "bylayer")'

replace "bylayer" with 'color'.

Like That

(command "color" color)

February 19

31 minutes ago, GLAVCVS said:
Simply:
On the line before '(foreach layer lstLayers... ' write
(if (= 
 (cdr (assoc 62 (tblsearch "layer" (getvar "CLAYER")))) 
 (setq color (vlax-get-property eo "layer"))
 )
 (setq color " bylayer")
)
And then, on the line:

'(command "color" "bylayer")'

replace "bylayer" with 'color'.

Like That
(command "color" color)

In the initial version, the text has the current layer, but it is necessary that the text layer corresponds
to the hatching layer. After changing the lines in the code, when inserting text, the name of the album of colors is requested...

(defun c:hatcharea-GL1 (/ ss area i eo pt lst layer lstLayers)
 (setq
 ss (ssget '((0 . "hatch")))
 area 0
 i 0
 )
 (cond
 ((and (and ss) (> (sslength ss) 0))
 (repeat (sslength ss)
 (setq eo (vlax-ename->vla-object (ssname ss i)))
 (setq area (vlax-get eo 'Area)
 layer (vlax-get-property eo "LAYER")
 )
 (if (setq lst (assoc layer lstLayers))
 (setq lstLayers (subst (list layer (+ (cadr lst) area)) lst lstLayers))
 (setq lstLayers (append lstLayers (list (list layer area))))
 )
 (setq i (+ i 1))
 )
 (if (= 
 (cdr (assoc 62 (tblsearch "layer" (getvar "CLAYER")))) 
 (setq color (vlax-get-property eo "layer"))
 )
 (setq color " bylayer")
)
 (foreach layer lstLayers
 (if (setq pt (getpoint (strcat "\nInsertion point for area HATCHs in layer \'" (strcase (car layer)) "\'")))
 (progn
 (setq area (cadr layer))
 (command "_.color" "_color")
 (command "_.STYLE" "Standard" "" 2 "" "" "" "")
 (command "_.text" pt 0 (strcat "Area = " (rtos area 2 2)) "")
 (command "_.STYLE" "Standard" "" 0.2 "" "" "" "")
 )
 )
 )
 )
 )
 (princ)
)

Edited February 19 by Nikon

February 19

Then, simply add before '(command "color" color)'

'(setvar "CLAYER" layer)'

February 19

14 minutes ago, GLAVCVS said:

Then, simply add before '(command "color" color)'

'(setvar "CLAYER" layer)'

Unfortunately
Insertion point for area HATCHs in layer '0'; error: Setting the AutoCAD variable is rejected: "CLAYER" ("0" 1.44904e+06)

February 19

Sorry
If the text must be on the same layer as the hatch, to avoid conflicts, disable the lines of code '(command "color" color)' and '(setvar "CLAYER" layer)'
and, simply add below '(command "text"...)'
'(vlax-put-layer eo layer)'

Edited February 19 by GLAVCVS

February 19

7 minutes ago, GLAVCVS said:

Sorry

If the text must be on the same layer as the hatch, to avoid conflicts, disable the lines of code '(command "color" color)' and '(setvar "CLAYER" layer)'
and, simply add below '(command "text"...)'
'(vlax-put-layer eo слой)'

error: no function definition: VLAX-PUT-LAYER

February 19

(defun c:hatcharea-GL1 (/ ss area i eo pt lst layer lstLayers color)
  (setq
    ss	 (ssget '((0 . "hatch")))
    area 0
    i	 0
  )
  (cond
    ((and (and ss) (> (sslength ss) 0))
     (repeat (sslength ss)
       (setq eo (vlax-ename->vla-object (ssname ss i)))
       (setq area  (vlax-get eo 'Area)
	     layer (vlax-get-property eo "LAYER")
       )
       (if (setq lst (assoc layer lstLayers))
	 (setq lstLayers (subst	(list layer (+ (cadr lst) area))
				lst
				lstLayers
			 )
	 )
	 (setq lstLayers (append lstLayers (list (list layer area))))
       )
       (setq i (+ i 1))
     )
     (if (= (setq color (vlax-get-property eo "COLOR")) 256)
       (setq color nil)
     )
     (foreach layer lstLayers
       (if (setq pt
		  (getpoint
		    (strcat "\nInsertion point for area HATCHs in layer \'"
			    (strcase (car layer))
			    "\'"
		    )
		  )
	   )
	 (progn
	   (setq area (cadr layer))
       (setvar "CECOLOR" "BYLAYER") 
	   (command "_.STYLE" "Standard" "" 2 "" "" "" "")
	   (command "_.text"
		    pt
		    0
		    (strcat "Area = " (rtos area 2 2))
		    ""
	   )
	   (command "_.STYLE" "Standard" "" 0.2 "" "" "" "")
	   (vla-put-layer (vlax-ename->vla-object (entlast)) (car layer))
	   (if color
	     (vla-put-color (vlax-ename->vla-object (entlast)) color)
	   )
	 )
       )
     )
    )
  )
  (princ)
)

Edited February 19 by GLAVCVS

February 19

Something else needs to be changed so that other texts have their own layer...

On 19.02.2025 at 15:16, GLAVCVS said:

(defun c:hatcharea-GL1 (/ ss area i eo pt lst layer lstLayers color)
 (setq
 ss (ssget '((0 . "hatch")))
 area 0
 i 0

Edited February 22 by Nikon

February 19

I edited something at the last minute.
You may need to copy the code again

February 19

16 minutes ago, GLAVCVS said:

I edited something at the last minute.
You may need to copy the code again

Everything is perfect now!
It wasn't that easy! Thank you many times!

Sign In

Find the total sum of hatch areas for different layers

Recommended Posts

ysf

GLAVCVS

SLW210

BIGAL

Nikon

GLAVCVS

Nikon

GLAVCVS

Nikon

GLAVCVS

Nikon

GLAVCVS

Nikon

GLAVCVS

Nikon

Join the conversation

Tutorials

Forums

Activity