A lisp file that can read the total area of each hatch and ....

[JamaL9722060]

A lisp file that can read the total area of each hatch and summarize them in a table,

Assume that I have multiple hatches of different patterns and color (attached) and I wanted to calculate their areas (and summarize them in a table along with a symbol represents their color) based on their color such that the areas of hatches of same color are accumulated.

This can be done partially using the command “extract data” but has two issues:

• It has no ability to stick a symbol for the color on the table (instead of listing their numbers)
• It has no ability to accumulate the areas in case they have similar color

Thank you

Best

Jamal

[FSJ_Mo]

just wanted to add that we sort different design elements by layer (each with their own color) and I would like to use this to do a quick check of how much area each layer accounts for. I have attched a sample drawing (2010 format) with swatches of each different layer (I am only interested in the hatch_**** layers)

[pbejse]

---

@FSJ_Mo wrote:

I was just wanting to use the layer name in the table beside the area totals instead of inserting a block with a swatch of the color. .... 

---

I see, its easy.

See attached lisp file.for q quick mod of the original lisp code

I believe you have enough knowledge in lsip to modify the rest to suit your needs.

Cheers

 EDIT: did not see your post there FSJ_Mo, I'll convert the file then have a look-see.

EDIT2: It appears to be working on initial test.

[FSJ_Mo]

that is great! Thank you

[pbejse]

---

@FSJ_Mo wrote:

that is great! Thank you

---

Good for you kind sir, and you are welcome.

Those VL thingy will come easy for you to learn as ou already have the knowledge of how things work with Autocad thru vanilla lisp.

Keep on coding dude

Cheers

[mid-awe]

Right on, this looks very interesting. I'm certain I can find some good uses for this one since we also use layer names for designation.

[mainisl]

Could you do a little modification

I want each object area inside or near a corner of object.

Regards

Ismail

[devitg]

Please upload your dwg sample, in 2007 if possible

[mbbuilds]

This is a great lisp pbejse, but I need help manipulating the code to include the hatch block, layer name, layer description, and area in sq ft. Ex:

(HATCH BLOCK "ZONE 40", LOT 1, JOHN SMITH, 230,703.00 SQ.FT.)  

I'm extremely illiterate to writing such lisp but am just beginning to understand how to read through the lines.  Any help would be greatly appreciated.

Thanks,

MB

[pbejse]

---

@mbbuilds wrote:

This is a great lisp pbejse, but I need help manipulating the code to include the hatch block, layer name, layer description, and area in sq ft. Ex:

(HATCH BLOCK "ZONE 40", LOT 1, JOHN SMITH, 230,703.00 SQ.FT.)  

..... 

Thanks,

MB

---

Why sure MB. its easy. post a sample drawing <preferably showiong the final table> [ I may need to review the previous code, its been a while since i wrote it]

[devitg]

Did you try DATAEXTRACTION ?, for me is the best tool for such task. It can be seen as a table at the dwg , or a XLS at the dwg folder

[mbbuilds]

I've figured out how to insert all that I initially asked from my limited coding skills.  However, the only hiccup stopping me from getting everything out of this lisp is getting the area of a merged hatch to insert as a field in the table.

(vla-setCellValue Area_table crow 3 
(strcat "%<\\AcObjProp Object(%<\\_ObjId "(itoa (cadr d))">%).Area>%"))

results in (HATCH BLOCK "ZONE 40", LOT 1, JOHN SMITH, ####) , not sure why?

devitg - I initially used dataextraction but haven’t yet figured out how to include the hatch block in the table, plus I’m not a big fan of all the .dxe files that I would have to create along the way.

(Defun c:HT2 ( / adoc AllData ss e edata Area_table crow bn area_ ssNH)
(vl-load-com)
;;; 	pBe 23Apr2013 							;;;
;;; Mod for FSJ_Mo : Layer instead of Block swatches 			;;;
;;;	pBe 18Jul2013							;;;
;;;	MB  03Jan2014 : includes block, layer, description, area	;;;
  (if 
    (setq AllData nil 
          ssNH    (ssadd)
          ss      (ssget '((0 . "Hatch")))
          adoc	 (vla-get-activedocument (vlax-get-acad-object))
    )
     (progn
       (repeat (setq i (sslength ss))
         (setq e (vlax-ename->vla-object (ssname ss (Setq i (1- i)))))
         (setq edata
                (list
                  (setq layer_ (vlax-get e 'Layer))
                  (setq area_ (vla-get-objectid e))
		  (vla-get-description (vlax-ename->vla-object (tblobjname "Layer" layer_)))
                )
         )
         (setq AllData (cons edata AllData)
         )
       )
       (setq AllData (vl-sort AllData '(lambda (m n) (< (Car m) (car n)))))
       (setq Area_table
              (vlax-invoke
                (vlax-get (vla-get-ActiveLayout
                            (vla-get-activedocument (vlax-get-acad-object))
                          )
                          'Block
                )
                'Addtable
                (getpoint "\nPick point for Table:")
                2 4 50 275
              )
       )
       (mapcar '(lambda (y)
       (vla-put-HeaderSuppressed Area_table :vlax-false)
                  (vla-settext Area_table 1 (car y) (cadr y))
                  (vla-setcelltextheight Area_table 1 (car y) 18)
                )
		(list '(0 "Hatch Pattern") '(1 "Layer Name") '(2 "Description") '(3 "Area"))
       )

       (foreach d AllData
         (vla-insertrows
           Area_table
           (1+ (setq crow (vla-get-rows Area_table)))
           50
           1
         )
	 (if (tblsearch "BLOCK" (setq bn (Car d)) )
           (progn
             (vla-setCellType Area_table crow 0 acBlockCell)
             (vla-SetBlockTableRecordId
               Area_table
               crow
               0
	       (vla-get-objectID
		 (vla-item 
		   (vla-get-blocks 
		     (vla-get-activedocument 
			(vlax-get-acad-object)
		      )
		   )
	           bn
	         )
	       ) 	
               :vlax-true
             )

             (vla-setAutoScale Area_table crow 0 :vlax-false)
             (vla-setBlockScale Area_table crow 0 0.8)
             (vla-setCellAlignment Area_table crow 0 5)
           )
           (princ (Strcat "\nBlock " bn " Not Found"))
         )
	 (vla-setcelltextheight Area_table crow 1 18)
         (vla-setCellAlignment Area_table crow 1 5)
	 (vla-setCellValue Area_table crow 1 (car d))

	 (vla-setcelltextheight Area_table crow 2 18)
         (vla-setCellAlignment Area_table crow 2 5)
	 (vla-setCellValue Area_table crow 2 (caddr d))
	
         (vla-setCellValue Area_table crow 3 
		(strcat "%<\\AcObjProp Object(%<\\_ObjId "(itoa (cadr d))">%).Area>%"))

         (vla-setcelltextheight Area_table crow 3 18)
         (vla-setCellAlignment Area_table crow 3 5)
	 (vla-setcellformat Area_table crow 3 "%lu2%ct4%qf1 SQ. FT.")
       
       ) 
     )
  ) 
  (princ)
)

[mbbuilds]

Also, I was hoping to suppress the title or header, whichever way gets rid of the blank row....

[pbejse]

---

@mbbuilds wrote:

I've figured out how to insert all that I initially asked from my limited coding skills.  However, the only hiccup stopping me from getting everything out of this lisp is getting the area of a merged hatch to insert as a field in the table.

(vla-setCellValue Area_table crow 3 
(strcat "%<\\AcObjProp Object(%<\\_ObjId "(itoa (cadr d))">%).Area>%"))

results in (HATCH BLOCK "ZONE 40", LOT 1, JOHN SMITH, ####) , not sure why?

---

Good for you for figuring out the rest mbbuilds. as for the field code use vla-settext instead of vla-setCellValue

(vla-setText Area_table crow 3 
		(strcat "%<\\AcObjProp Object(%<\\_ObjId "(itoa (cadr d))">%).Area>%"))

 HTH

[pbejse]

---

@mbbuilds wrote:

Also, I was hoping to suppress the title or header, whichever way gets rid of the blank row....

---

See attached modified LSP file

HTH

[mbbuilds]

At first glance this worked great and thanks for all your help, however upon further testing, I noticed the field goes missing if I link it to a hatch within a block.  Whereas, dataextraction maintains this link between the block and hatched area.  What does the data extraction use to reference the property, and is there a way to replicate this into this table, or should I just switch my focus towards using the data extraction and write a lisp to fill in the blocks?  I noticed the Object ID which we use to reference the area in our lisp chances anytime you refedit the block.

[pbejse]

---

@mbbuilds wrote:

At first glance this worked great and thanks for all your help, however upon further testing, I noticed the field goes missing if I link it to a hatch within a block.  Whereas, dataextraction maintains this link between the block and hatched area.  What does the data extraction use to reference the property, and is there a way to replicate this into this table, or should I just switch my focus towards using the data extraction and write a lisp to fill in the blocks?  I noticed the Object ID which we use to reference the area in our lisp chances anytime you refedit the block.

---

A sample of that would be nice.

I guess that would be best, but does it support field data?

 That is why i need you to post a sample drawing, I have not been able to replicate that condition.

[mbbuilds]

Defun c:HT2 ( / adoc AllData ss e edata Area_table crow bn area_ ssNH)
(vl-load-com)
;;; 	pBe 23Apr2013 							;;;
;;; Mod for FSJ_Mo : Layer instead of Block swatches 			;;;
;;;	pBe 18Jul2013							;;;
;;;	MB  03Jan2014 : includes block, layer, description, area	;;;
  (command "-refedit" pause "o" "a" "y")
  (command "regenall")
  (if 
    (setq AllData nil 
          ssNH    (ssadd)
          ss      (ssget '((0 . "Hatch")))
          adoc	 (vla-get-activedocument (vlax-get-acad-object))
    )
     (progn
       (repeat (setq i (sslength ss))
         (setq e (vlax-ename->vla-object (ssname ss (Setq i (1- i)))))
         (setq edata
                (list
                  (setq layer_ (vlax-get e 'Layer))
                  (setq area_ (vla-get-objectid e))
		  (vla-get-description (vlax-ename->vla-object (tblobjname "Layer" layer_)))
                )
         )
         (setq AllData (cons edata AllData)
         )
       )
       (setq AllData (vl-sort AllData '(lambda (m n) (< (Car m) (car n)))))
       (setq Area_table
              (vlax-invoke
                (vlax-get (vla-get-ActiveLayout
                            (vla-get-activedocument (vlax-get-acad-object))
                          )
                          'Block
                )
                'Addtable
                (getpoint "\nPick point for Table:")
                2 5 62 790
              )
       )
       (mapcar '(lambda (y)
       
                  (vla-settext Area_table 1 (car y) (cadr y))

		  (vla-setcolumnwidth Area_Table 0 144)
		  (vla-setcolumnwidth Area_Table 1 168)
		  (vla-setcolumnwidth Area_Table 3 147)
		  (vla-setcolumnwidth Area_Table 4 72)

		  (vla-setCellAlignment Area_table 1 0 1)
		  (vla-setCellAlignment Area_table 1 1 1)
		  (vla-setCellAlignment Area_table 1 2 1)
		  (vla-setCellAlignment Area_table 1 3 3)
		  (vla-setCellAlignment Area_table 1 4 3)
                  (vla-setcelltextheight Area_table 1 (car y) 18)
                )
		(list '(0 "Hatch Pattern") '(1 "Layer") '(2 "Lot Name") '(3 "Space Area") '(4 " "))

      )
      (vlax-put Area_table 'HorzCellMargin 11.52) 
      (vlax-put Area_table 'VertCellMargin 0.0)
      (vla-put-RegenerateTableSuppressed Area_table :vlax-true)
      (foreach d AllData
         (vla-insertrows
           Area_table
           (1+ (setq crow (vla-get-rows Area_table)))
           48
           1
         )
	 (if (tblsearch "BLOCK" (setq bn (Car d)) )
           (progn
             (vla-setCellType Area_table crow 0 acBlockCell)
             (vla-SetBlockTableRecordId
               Area_table
               crow
               0
	       (vla-get-objectID
		 (vla-item 
		   (vla-get-blocks 
		     (vla-get-activedocument 
			(vlax-get-acad-object)
		      )
		   )
	           bn
	         )
	       ) 	
               :vlax-true
             )
             (vla-setAutoScale Area_table crow 0 :vlax-false)
             (vla-setBlockScale Area_table crow 0 1)
             (vla-setCellAlignment Area_table crow 0 4)
           )
           (princ (Strcat "\nBlock " bn " Not Found"))
         ) 
	 (vla-setcelltextheight Area_table crow 1 18)
         (vla-setCellAlignment Area_table crow 1 4)
	 (vla-setCellValue Area_table crow 1 (car d))

	 (vla-setcelltextheight Area_table crow 2 18)
         (vla-setCellAlignment Area_table crow 2 4)
	 (vla-setCellValue Area_table crow 2 (caddr d))
	
         (vla-setText Area_table crow 3 
		(strcat "%<\\AcObjProp Object(%<\\_ObjId "(itoa (cadr d))">%).Area>%"))
         (vla-setcelltextheight Area_table crow 3 18)
         (vla-setCellAlignment Area_table crow 3 6)
	 (vla-setcellformat Area_table crow 3 "%lu2%ct4%qf1")

	 (vla-setcelltextheight Area_table crow 4 12)
         (vla-setCellAlignment Area_table crow 4 6)
	 (vla-setCellValue Area_table crow 4 "Sq. Ft.")
       
       )
       (vla-deleterows Area_table 0 1) 
       (vla-put-RegenerateTableSuppressed Area_table :vlax-false)
	
     )
  ) 
  (princ)
  (command "refset" "rem" pause "")
  (command "refclose" "s")
)

[pbejse]

---

@mbbuilds wrote:

Defun c:HT2 ( / adoc AllData ss e edata Area_table crow bn area_ ssNH)
...
  (command "refclose" "s")
)

---

Interesting, I'll have a look-see later. I might use a different approach that what you have now.

[kheajohn]

Hi,

i tried to your lisp routine....its very good. But is it also possible to get the description under the description of a layer, and to hatch automatically in the table according to the color assigned in the layer? i will appreciate if you can share. Thanks

[JamaL9722060]

To be able to use the lisp file that summarizes the total areas of hatches in a table, each hatch has to have a block with a name that carries ITS COLOR NUMBER. Please, have a look on the attached screenshot (the dwg file is also attached).

Many thanks go to pbejse, the author of this great lisp.