Block count by Values

March 31, 2020

I want to know how many door types I have by using the Door Tag (Attribute Block)

I have to attribute values, on top are the room numbers, below is the door type.

I found this lisp by @Lee Mac

http://www.lee-mac.com/countattributevalues.html

but i counts all the attributes in the selected blocks

Can we have an option to select which tag we want to count?

March 31, 2020

What's wrong with that code by Lee? You can just look at the table for which tag you're after

March 31, 2020

4 minutes ago, Jonathan Handojo said:

What's wrong with that code by Lee? You can just look at the table for which tag you're after

Nothing's wrong with Lee's code.

I just want to show the Door Types in the table only without the room numbers above.

Coz, number of doors keeps on changing. That means i also need to edit the rows for the room numbers every now and then

March 31, 2020

With that same code that you found loaded:

(defun c:dtype ( / rown tab tags vtab)
  (setq tags '("Door" "Number"))	; <--- Replace with the tags you want shown
  (c:CountAttributeValues)
  (setq tab (entlast)
	vtab (vlax-ename->vla-object tab)
	)
  (repeat (- (setq rown (cdr (assoc 91 (entget tab)))) 2)
    (if (null (vl-position (vla-GetText vtab (setq rown (1- rown)) 0) tags))
      (vla-DeleteRows vtab rown 1)
      )
    )
  )

March 31, 2020

14 hours ago, Jonathan Handojo said:

With that same code that you found loaded:


(defun c:dtype ( / rown tab tags vtab)
  (setq tags '("Door" "Number"))	; <--- Replace with the tags you want shown
  (c:CountAttributeValues)
  (setq tab (entlast)
	vtab (vlax-ename->vla-object tab)
	)
  (repeat (- (setq rown (cdr (assoc 91 (entget tab)))) 2)
    (if (null (vl-position (vla-GetText vtab (setq rown (1- rown)) 0) tags))
      (vla-DeleteRows vtab rown 1)
      )
    )
  )

Thanks a lot @Jonathan Handojo

Will test this tomorrow as I don't have Autocad at home

EDIT :
Just tested it today, it didn't show the tags in the table.
Only the title is shown.

This is what i did...Lee's code is in the support folder so calling it still works,

I need to show the DR_CODE only.

Quote

(defun c:dtype ( / rown tab tags vtab)
(setq tags '("DR_CODE" "DRNO"))   ; <--- Replace with the tags you want shown
(c:CountAttributeValues)
(setq tab (entlast)
   vtab (vlax-ename->vla-object tab)
   )
(repeat (- (setq rown (cdr (assoc 91 (entget tab)))) 2)
(if (null (vl-position (vla-GetText vtab (setq rown (1- rown)) 0) tags))
(vla-DeleteRows vtab rown 1)
)
)
)

Edited April 1, 2020 by CAD_Noob

April 1, 2020

I am working on something similar it would allow say "att1" "att2" "att3" up to tested on 25 atts it sorts on up to the 1st 5 atts. Similar to lees.

So taking a room you would get something like "size" "color" "handle" for doors = 2400x820 black gold 25 then 2400x820 black silver 15 and so on it mix and matches blocks

2400x820 black gold 25

2400x820 black silver 15

Table 900x600 white 15

table 900x600 grey 15

table 900x600 timb 10

and so on

The issue is I don't have a skip attribute so it would use say room as the 1st a sneaky way around though is you can change block attribute order not its visual position. So could limit the sort depth so skips roomnum.

Happy to have a look at a sample dwg if you want to post.

Edited April 1, 2020 by BIGAL

April 1, 2020

Is the tag supposed to be an exact match or a wildcard match?

April 1, 2020

5 minutes ago, Jonathan Handojo said:

Is the tag supposed to be an exact match or a wildcard match?

it's exact. I attached the Door Tag i used.

I only need the count and values of the below

A-_DOORTAG-_E-.dwg

April 1, 2020

Oh well, forget Lee's CAV...

(defun c:dtype ( / *error* acadobj activeundo adoc atts col countlst dets hgt i lst msp rown rtn ss tags vals vtab vtable x)
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
      )
    )
  
  (defun countlst (lst / rtn)	; <--- Lee Mac has one LM:CountItems , but it doesn't hurt to make another. Both returns the same
    (mapcar '(lambda (x) (if (null (assoc x rtn)) (setq rtn (cons (cons x (- (length lst) (length (vl-remove x lst)))) rtn)))) lst)
    (reverse rtn)
    )
  
  (setq acadobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acadobj)
        msp (vla-get-ModelSpace adoc)
        activeundo nil)
  (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))

  
  (setq tags '("DRNO")	; <-- List of tags to show
	hgt 400		; <-- Table row height
	col 2000	; <-- Table column width (I can't be bothered to calculate based on text style)
	)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (progn
      (repeat (setq i (sslength ss))
	(if (setq atts (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'getattributes))
	  (foreach x atts
	    (if (vl-position (vla-get-TagString x) tags)
	      (setq vals (cons (vla-get-TextString x) vals))
	      )
	    )
	  )
	)
      (setq vtab (vla-AddTable msp (vlax-3d-point (progn (initget 1) (getpoint "\nSpecify insertion point: "))) (+ 2 (length (setq dets (countlst vals)))) 2 hgt col)
	    rown 1
	    )
      (foreach x
	       '(
		 (0 0 "Attributes")
		 (1 0 "Value")
		 (1 1 "Total")
		 )
	(apply 'vla-SetText (append (list vtab) x))
	)
      (repeat (length dets)
	(vla-SetText vtab (setq rown (1+ rown)) 0 (caar dets))
	(vla-SetText vtab rown 1 (cdar dets))
	(setq dets (cdr dets))
	)
      )
    )
  (if activeundo nil (vla-EndUndoMark adoc))
  (princ)
  )

Edited April 1, 2020 by Jonathan Handojo

April 2, 2020

13 hours ago, Jonathan Handojo said:

Oh well, forget Lee's CAV...


(defun c:dtype ( / *error* acadobj activeundo adoc atts col countlst dets hgt i lst msp rown rtn ss tags vals vtab vtable x)
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
      )
    )
  
  (defun countlst (lst / rtn)	; <--- Lee Mac has one LM:CountItems , but it doesn't hurt to make another. Both returns the same
    (mapcar '(lambda (x) (if (null (assoc x rtn)) (setq rtn (cons (cons x (- (length lst) (length (vl-remove x lst)))) rtn)))) lst)
    (reverse rtn)
    )
  
  (setq acadobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acadobj)
        msp (vla-get-ModelSpace adoc)
        activeundo nil)
  (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))

  
  (setq tags '("DRNO")	; <-- List of tags to show
	hgt 400		; <-- Table row height
	col 2000	; <-- Table column width (I can't be bothered to calculate based on text style)
	)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (progn
      (repeat (setq i (sslength ss))
	(if (setq atts (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'getattributes))
	  (foreach x atts
	    (if (vl-position (vla-get-TagString x) tags)
	      (setq vals (cons (vla-get-TextString x) vals))
	      )
	    )
	  )
	)
      (setq vtab (vla-AddTable msp (vlax-3d-point (progn (initget 1) (getpoint "\nSpecify insertion point: "))) (+ 2 (length (setq dets (countlst vals)))) 2 hgt col)
	    rown 1
	    )
      (foreach x
	       '(
		 (0 0 "Attributes")
		 (1 0 "Value")
		 (1 1 "Total")
		 )
	(apply 'vla-SetText (append (list vtab) x))
	)
      (repeat (length dets)
	(vla-SetText vtab (setq rown (1+ rown)) 0 (caar dets))
	(vla-SetText vtab rown 1 (cdar dets))
	(setq dets (cdr dets))
	)
      )
    )
  (if activeundo nil (vla-EndUndoMark adoc))
  (princ)
  )

I think it's working. got some issues with text size though, it's too small though the cell height is too big.

I set my textsize to 250 but it doesn't have any effect.

here's the screenshot of the table.

The one on the left is using CAV by Lee, the one on the right is the dtype lisp.

Edited April 2, 2020 by CAD_Noob

April 2, 2020

Just now, CAD_Noob said:

I think it's working. got some issues with text size though,

That depends on your current table style. If your table style has a big text, then it should be big. Otherwise you can set the table row height and column width to suit. I can't be bothered to calculate that like Lee did. You can simply add another line at the start.

(setvar "CTABLESTYLE" your_style_name)

April 2, 2020

4 minutes ago, Jonathan Handojo said:
That depends on your current table style. If your table style has a big text, then it should be big. Otherwise you can set the table row height and column width to suit. I can't be bothered to calculate that like Lee did. You can simply add another line at the start.
(setvar "CTABLESTYLE" your_style_name)

where will i put this?

April 2, 2020

13 minutes ago, CAD_Noob said:

where will i put this?

Actually, don't mind that, this is a better approach:

(defun c:dtype ( / acadobj activeundo adoc atts col countlst desired dets hgt i lst msp rown rtn ss tags vals vtab vtable x)
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
      )
    )
  
  (defun countlst (lst / rtn)	; <--- Lee Mac has one LM:CountItems , but it doesn't hurt to make another. Both returns the same
    (mapcar '(lambda (x) (if (null (assoc x rtn)) (setq rtn (cons (cons x (- (length lst) (length (vl-remove x lst)))) rtn)))) lst)
    (reverse rtn)
    )
  
  (setq acadobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acadobj)
        msp (vla-get-ModelSpace adoc)
        activeundo nil)
  (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))

  
  (setq tags '("DRNO")	; <-- List of tags to show
	hgt 400		; <-- Table row height
	col 2000	; <-- Table column width (I can't be bothered to calculate based on text style)

	;; Table style Name here
	desired "YourStyleName"
	)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (progn
      (repeat (setq i (sslength ss))
	(if (setq atts (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'getattributes))
	  (foreach x atts
	    (if (vl-position (vla-get-TagString x) tags)
	      (setq vals (cons (vla-get-TextString x) vals))
	      )
	    )
	  )
	)
      (setq vtab (vla-AddTable msp (vlax-3d-point (progn (initget 1) (getpoint "\nSpecify insertion point: "))) (+ 2 (length (setq dets (countlst vals)))) 2 hgt col)
	    rown 1
	    )

      (vl-catch-all-apply 'vla-put-StyleName (list vtab desired))	; <--- set table to desired table style
      (foreach x
	       '(
		 (0 0 "Attributes")
		 (1 0 "Value")
		 (1 1 "Total")
		 )
	(apply 'vla-SetText (append (list vtab) x))
	)
      (repeat (length dets)
	(vla-SetText vtab (setq rown (1+ rown)) 0 (caar dets))
	(vla-SetText vtab rown 1 (cdar dets))
	(setq dets (cdr dets))
	)
      )
    )
  (if activeundo nil (vla-EndUndoMark adoc))
  (princ)
  )

Change "YourStyleName" into the table style name.

Edited April 2, 2020 by Jonathan Handojo

April 2, 2020

Try (vla-SetTextHeight tableobj (+ acDataRow acHeaderRow acTitleRow) txtht) you are setting colwidth etc so make a guess.

My need also (VLA-SETCELLTEXTHEIGHT tableobj rownum k txtht)

I have problems changing an unknown style so have to hit it with big hammer.

April 2, 2020

5 minutes ago, Jonathan Handojo said:

Actually, don't mind that, this is a better approach:


(defun c:dtype ( / acadobj activeundo adoc atts col countlst desired dets hgt i lst msp rown rtn ss tags vals vtab vtable x)
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
      )
    )
  
  (defun countlst (lst / rtn)	; <--- Lee Mac has one LM:CountItems , but it doesn't hurt to make another. Both returns the same
    (mapcar '(lambda (x) (if (null (assoc x rtn)) (setq rtn (cons (cons x (- (length lst) (length (vl-remove x lst)))) rtn)))) lst)
    (reverse rtn)
    )
  
  (setq acadobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acadobj)
        msp (vla-get-ModelSpace adoc)
        activeundo nil)
  (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))

  
  (setq tags '("DRNO")	; <-- List of tags to show
	hgt 400		; <-- Table row height
	col 2000	; <-- Table column width (I can't be bothered to calculate based on text style)

	;; Table style Name here
	desired "YourStyleName"
	)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (progn
      (repeat (setq i (sslength ss))
	(if (setq atts (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'getattributes))
	  (foreach x atts
	    (if (vl-position (vla-get-TagString x) tags)
	      (setq vals (cons (vla-get-TextString x) vals))
	      )
	    )
	  )
	)
      (setq vtab (vla-AddTable msp (vlax-3d-point (progn (initget 1) (getpoint "\nSpecify insertion point: "))) (+ 2 (length (setq dets (countlst vals)))) 2 hgt col)
	    rown 1
	    )

      (vla-put-StyleName vtab desired)	; <--- set table to desired table style
      (foreach x
	       '(
		 (0 0 "Attributes")
		 (1 0 "Value")
		 (1 1 "Total")
		 )
	(apply 'vla-SetText (append (list vtab) x))
	)
      (repeat (length dets)
	(vla-SetText vtab (setq rown (1+ rown)) 0 (caar dets))
	(vla-SetText vtab rown 1 (cdar dets))
	(setq dets (cdr dets))
	)
      )
    )
  (if activeundo nil (vla-EndUndoMark adoc))
  (princ)
  )

Change "YourStyleName" into the table style name.

Followed this one. I use "Standard" set the text height to 250. but i cannot change the header/title text size...

April 2, 2020

I guess you can just set the header and title style straight from the Table Style Manager to 250. Or do as BIGAL says within the code, but result will be different if you change the style to something else and then reverting it back.

For BIGAL's approach on my code, under this line (vl-catch-all-apply 'vla-put-StyleName (list vtab desired)) [or you can even replace it actually], put:

(vla-SetTextHeight vtab (+ acDataRow acHeaderRow acTitleRow) 250)

Edited April 2, 2020 by Jonathan Handojo

April 2, 2020

12 minutes ago, BIGAL said:

I have problems changing an unknown style so have to hit it with big hammer.

Which is why I just do (vl-catch-all-apply 'vla-put-StyleName (list vlatable stylename)). But it does make sense to just set the height straight away like you suggested. In my case, I never have to change the table style to something else, and then back, so it should be fine. But if that does happen, then the text height won't be the same.

Edited April 2, 2020 by Jonathan Handojo

April 2, 2020

Just now, Jonathan Handojo said:

I guess you can just set the header and title style straight from the Table Style Manager to 250.

yah, noticed i can edit that from the properties panel...

Thanks.

April 2, 2020

1 hour ago, Jonathan Handojo said:
I guess you can just set the header and title style straight from the Table Style Manager to 250. Or do as BIGAL says within the code, but result will be different if you change the style to something else and then reverting it back.

For BIGAL's approach on my code, under this line (vl-catch-all-apply 'vla-put-StyleName (list vtab desired)) [or you can even replace it actually], put:
(vla-SetTextHeight vtab (+ acDataRow acHeaderRow acTitleRow) 250)

That did it! thanks a lot!! working fine.

one more question, any way to sort the value alphanumeric?

Where DXXX comes first then RXXX?

or i can do that in the table? I cannot find a way to do that in the table itself.

April 2, 2020

2 hours ago, BIGAL said:

Try (vla-SetTextHeight tableobj (+ acDataRow acHeaderRow acTitleRow) txtht) you are setting colwidth etc so make a guess.

My need also (VLA-SETCELLTEXTHEIGHT tableobj rownum k txtht)

I have problems changing an unknown style so have to hit it with big hammer.

Thanks a lot @BIGAL

Block count by Values

Recommended Posts

CAD_Noob

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Jonathan Handojo

Jonathan Handojo

BIGAL

Posted Images

Jonathan Handojo

Link to comment

Share on other sites

CAD_Noob

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

CAD_Noob

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

CAD_Noob

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

CAD_Noob

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

CAD_Noob

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

CAD_Noob

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

CAD_Noob

Link to comment

Share on other sites

CAD_Noob

Link to comment

Share on other sites

CAD_Noob

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity