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

[devitg]

Erased by user

[smaher12]

Maybe you can build from this

(defun c:tmp (/ area sset P1)
      	(vl-load-com)
      (cond ((and
	      	(ssget ":L" '((0 . "Hatch")))
	      	(setq area 0)
	     	(vlax-for H (setq sset (vla-get-activeselectionset
	                                     (vla-get-activedocument
	                                           (vlax-get-acad-object))))
	              (setq area (+ (vla-get-area h) area))
	              )


              (setq P1 (getpoint "\nPick text point: "))

        (entmake
          (list
            (cons 0 "TEXT")
            (cons 40 18.0)               
            (cons 10 P1)
            (cons 1 (strcat
		            "\nTotal Area = "
		            (if (or (= (getvar "lunits") 3)
		                    (= (getvar "lunits") 4))
		                  (strcat
		                        (rtos area 2 2)
		                        " sq. in. ("
		                        (rtos (/ area 144) 2 2)
		                        " sq. ft.)")
		                  (rtos area))))
          );list
        );entmakex
                (vla-delete sset)
                ))
            )
      	)

[JamaL9722060]

Thank you devitg and smaher12 for the answer,

Sounds that my point is not clear,

Please, have a look on the attached screenshot

For example, in the dwg file attached in my previous post, if the hatch that has color #40 is selected then its total area is 230703.0037 while id the hatch that has color #143 is selected then its total area is 182187.3266 and so forth.

What I wanted is to summarize the hatches according their colors and their corresponding total area (for each color)

Best

Jamal

[smaher12]

I only know enough to lisp to be slightly dangerous. Please excuse me for putting this together one piece at a time. This is what I have patched together so far.

(defun c:tmp (/ co area sset P1)
(vl-load-com)
      (cond ((and
		(setq co (assoc 62 (entget (car (entsel)))))
		(ssget "X" (list (cons 0 "Hatch")(cons -4 "<or") co (cons -4 "or>")))
	      	(setq area 0)
	     	(vlax-for H (setq sset (vla-get-activeselectionset
	                                     (vla-get-activedocument
	                                           (vlax-get-acad-object))))
	              (setq area (+ (vla-get-area h) area))
	              )
	(setq P1 (getpoint "\nPick text location: "))
        (entmake
          (list
            (cons 0 "TEXT")
            (cons 40 18.0)               
            (cons 10 P1)
            (cons 1 (strcat
		            "\nTotal Area = "
		            (if (or (= (getvar "lunits") 3)
		                    (= (getvar "lunits") 4))
		                  (strcat (rtos area 2 4))
		                )
                            )
                     )
          );list
        );entmake
                (vla-delete sset)
                ))
            )
      	)

[pbejse]

May I suggest not recreating the table and used the one you already have as a "block". You may gave to modify your "color" blocks to make it all one size and same insertion point. Only thing left to code is the "sum"

Are you okay with that approach?

[pbejse · Accepted solution]

Okay, I change my mind.   Better to create a new table and set the specifics. Try this code on the attached drawing file.

On that file i created 10 blocks named "Zone 40", "Zone 143" ....... \

(Defun c:HatchTAble ( / AllData ss e edata Area_table crow bn)
(vl-load-com)
;;; pBe 23Apr2013 ;;;
  (if
    (setq AllData nil
          ss      (ssget '((0 . "Hatch")))
    )
     (progn
       (repeat (setq i (sslength ss))
         (setq e (vlax-ename->vla-object (ssname ss (Setq i (1- i)))))
         (setq edata (mapcar '(lambda (o)
                                (vlax-get e o)
                              )
                             (list 'Color 'Area)
                     )
         )
         (setq AllData
                (if (setq f (assoc (car edata) AllData))
                  (subst (list (car f) (+ (cadr f) (cadr edata))) f Alldata)
                  (cons edata AllData)
                )
         )
       )
       (setq AllData (vl-sort AllData '(lambda (m n) (> (Cadr m) (cadr 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  2 50 275
              )
       )
       (vla-settext Area_table 0 0 "Area Tabulation")
       (vla-setcelltextheight Area_table 0 0 20.0)
       (mapcar '(lambda (y)
                  (vla-settext Area_table 1 (car y) (cadr y))
                  (vla-setcelltextheight Area_table 1 (car y) 20.0)
                )
               (list '(0 "Area") '(1 "Color"))
       )

       (foreach d AllData
         (vla-insertrows
           Area_table
           (1+ (setq crow (vla-get-rows Area_table)))
           50
           1
         )
         ;(vla-settext Area_table crow 0 (rtos (cadr d) 2 2))
         (vla-setCellValue Area_table crow 0 (cadr d))
         (vla-setcelltextheight Area_table crow 0 20.0)
         (vla-setCellAlignment Area_table crow 0 5)
         (vla-setcellformat Area_table crow 0 "%lu2%pr2%th44")
         (if (tblsearch "BLOCK" (setq bn (strcat "Zone " (itoa (Car d)))))
           (progn
             (vla-setCellType Area_table crow 1 acBlockCell)
             (vla-SetBlockTableRecordId
               Area_table
               crow
               1
               (vla-get-objectID
                 (vla-item
                   (vla-get-blocks
                     (vla-get-activedocument
                       (vlax-get-acad-object)
                     )
                   )
                   bn
                 )
               )
               :vlax-true
             )
             (vla-setAutoScale Area_table crow 1 :vlax-false)
             (vla-setBlockScale Area_table crow 1 0.85)
             (vla-setCellAlignment Area_table crow 1 5)
           )
           (princ (Strcat "\nBlock " bn " Not Found"))
         )
       )
     )
  )
  (princ)
)

 The result is a sorted table with Area on the left side and the block on the right.

HTH

[JamaL9722060]

Perfect! Thank you pbejse so much for the massive effort. This is fantastic

I don’t know how to thank you for the great work you have done

Really very much appreciated

Best

Jamal

[JamaL9722060]

Thanks smaher12,

Best

Jamal

[BlackBox_]

---

@pbejse wrote:

Okay, I change my mind.   Better to create a new table and set the specifics. Try this code on the attached drawing file.

On that file i created 10 blocks named "Zone 40", "Zone 143" ....... \

(Defun c:HatchTAble ( / AllData ss e edata Area_table crow bn)
(vl-load-com)
;;; pBe 23Apr2013 ;;;
  (if
    (setq AllData nil
          ss      (ssget '((0 . "Hatch")))
    )
     (progn
       (repeat (setq i (sslength ss))
         (setq e (vlax-ename->vla-object (ssname ss (Setq i (1- i)))))
         (setq edata (mapcar '(lambda (o)
                                (vlax-get e o)
                              )
                             (list 'Color 'Area)
                     )
         )
         (setq AllData
                (if (setq f (assoc (car edata) AllData))
                  (subst (list (car f) (+ (cadr f) (cadr edata))) f Alldata)
                  (cons edata AllData)
                )
         )
       )
       (setq AllData (vl-sort AllData '(lambda (m n) (> (Cadr m) (cadr 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  2 50 275
              )
       )
       (vla-settext Area_table 0 0 "Area Tabulation")
       (vla-setcelltextheight Area_table 0 0 20.0)
       (mapcar '(lambda (y)
                  (vla-settext Area_table 1 (car y) (cadr y))
                  (vla-setcelltextheight Area_table 1 (car y) 20.0)
                )
               (list '(0 "Area") '(1 "Color"))
       )

       (foreach d AllData
         (vla-insertrows
           Area_table
           (1+ (setq crow (vla-get-rows Area_table)))
           50
           1
         )
         ;(vla-settext Area_table crow 0 (rtos (cadr d) 2 2))
         (vla-setCellValue Area_table crow 0 (cadr d))
         (vla-setcelltextheight Area_table crow 0 20.0)
         (vla-setCellAlignment Area_table crow 0 5)
         (vla-setcellformat Area_table crow 0 "%lu2%pr2%th44")
         (if (tblsearch "BLOCK" (setq bn (strcat "Zone " (itoa (Car d)))))
           (progn
             (vla-setCellType Area_table crow 1 acBlockCell)
             (vla-SetBlockTableRecordId
               Area_table
               crow
               1
               (vla-get-objectID
                 (vla-item
                   (vla-get-blocks
                     (vla-get-activedocument
                       (vlax-get-acad-object)
                     )
                   )
                   bn
                 )
               )
               :vlax-true
             )
             (vla-setAutoScale Area_table crow 1 :vlax-false)
             (vla-setBlockScale Area_table crow 1 0.85)
             (vla-setCellAlignment Area_table crow 1 5)
           )
           (princ (Strcat "\nBlock " bn " Not Found"))
         )
       )
     )
  )
  (princ)
)

 The result is a sorted table with Area on the left side and the block on the right.

HTH

---

I hate to be the bearor of bad news, my friend, but you're assuming that all Hatch patterns have a valid Area Property (and they don't, especially so for custom patterns):

Command: HATCHTABLE

Select objects: 1 found

Select objects: 1 found, 2 total

Select objects:
; error: AutoCAD.Application: Invalid input

... See my code here.

[JamaL9722060]

Thanks BlackBoxCAD,

But I think in my case all hatches have area!

Best

Jamal

[BlackBox_]

---

@JamaL9722060 wrote:

Thanks BlackBoxCAD,

But I think in my case all hatches have area!

Best

Jamal

---

No worries, Jamal... Most users won't run into an issue... As you can see, I did, and so I thought I'd share. That's all.

Cheers

[smaher12]

---

@JamaL9722060 wrote:

Thanks smaher12,

Best

Jamal

---

No problem. I just thought I would give it a try a little at a time.

pbejse: Hats off... I have so much to learn.

[pbejse]

---

@BlackBoxCAD wrote:

I hate to be the bearor of bad news, my friend, but you're assuming that all Hatch patterns have a valid Area Property (and they don't, especially so for custom patterns):

Command: HATCHTABLE

Select objects: 1 found

Select objects: 1 found, 2 total

Select objects:
; error: AutoCAD.Application: Invalid input

---

Good point BlackBox.

I pride myself in following a set of rules, especially this -->  "Better have and not need, than need and not have", and yet I break that rule more often than not. 

The modified code [attached] will highlight the "HATCH" with no area for the user to "fix" later.

Cheers  

[pbejse]

---

@JamaL9722060 wrote:

Thank you pbejse so much for the massive effort.....

Really very much appreciated

Jamal

---

You are welcome, Happy to help.

Cheers

[pbejse]

---

@smaher12 wrote:

 pbejse: Hats off... I have so much to learn.

---

Thank you for that  smaher12, You'll get there, my advise to you,  practice.. practice.. practice..... 

[BlackBox_]

---

@pbejse wrote:

---

Good point BlackBox.

---

Cheers, pbejse.  

[Anonymous]

Hi, a little late to the discussion, but

how would I go about using the layer name instead of inserting a block in the table?

[pbejse]

---

@Anonymous wrote:

how would I go about using the layer name instead of inserting a block in the table?

---

What do you mean by that FSJ_Mo?

[Anonymous]

Hi,  I used to do a fair bit of coding in Autolisp back in the day and am just getting back into it. I am not very familiar with these VLA* functions.

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 was wondering if someone could point me in the right direction.

Thanks