Find the total sum of hatch areas for different layers

[ysf]

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 Sunday at 06:54 PM by SLW210
Added Code Tags!!

[GLAVCVS]

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)
)

 

[SLW210]

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

[BIGAL]

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. 

[Nikon]

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.

[GLAVCVS]

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)

 

[Nikon]

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 Wednesday at 10:46 AM by Nikon

[GLAVCVS]

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

'(setvar "CLAYER" layer)'

[Nikon]

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)

[GLAVCVS]

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 Wednesday at 11:22 AM by GLAVCVS

[Nikon]

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

[GLAVCVS]

(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 Wednesday at 12:20 PM by GLAVCVS

[Nikon]

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

6 minutes ago, 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 Wednesday at 12:23 PM by Nikon

[GLAVCVS]

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

[Nikon]

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!