Author Topic: Counting Block TAG per Block TAG  (Read 3966 times)

0 Members and 1 Guest are viewing this topic.

antistar

  • Guest
Counting Block TAG per Block TAG
« on: January 08, 2014, 11:41:16 AM »
Hello to all.
I have the same block with 4 tag texts inserted several times in the drawing like this:
Block Name: SteelDim
Tag: Name
Tag: TIT
Tag: FASE
Tag: Level

I need a routine that extracts a list (TextScreen) in alphabetical order counting how many times occur FASE with TIT.
Example:

-------------------------------------------------------------------------------------------
> TITvalueX
> FASEvalueA / FASEvalueD / FASEvalueF / FASEvalueT (4x)
-------------------------------------------------------------------------------------------
> TITvalueY
> FASEvalueG / FASEvalueM (2x)
--------------------------------------------------------------------------------------------
> TITvalueZ
> FASEvalueB / FASEvalueO / DimvalueS (3x)
--------------------------------------------------------------------------------------------

Can anyone help me?

Thanks in advance.

ymg

  • Guest
Re: Counting Block TAG per Block TAG
« Reply #1 on: January 08, 2014, 12:06:59 PM »
antistar,

Not completely clear, your block always contains TIT and FASE. So you'll end up simply counting the blocks.

Or maybe you mean counting the block that have a common value under FASE.

Upload a drawing with typical data.  Right now all tou have in your drawing is the block definition.

ymg

Krushert

  • Seagull
  • Posts: 13679
  • FREE BEER Tomorrow!!
Re: Counting Block TAG per Block TAG
« Reply #2 on: January 08, 2014, 12:14:14 PM »
Upload a drawing with typical data.  Right now all tou have in your drawing is the block definition.
Yes please upload example drawing with couple of blocks populated with examples of the values that you expect to see.
I + XI = X is true ...  ... if you change your perspective.

I no longer CAD or Model, I just hang out here picking up the empties beer cans

antistar

  • Guest
Re: Counting Block TAG per Block TAG
« Reply #3 on: January 08, 2014, 12:50:35 PM »
antistar,

Not completely clear, your block always contains TIT and FASE. So you'll end up simply counting the blocks.

Or maybe you mean counting the block that have a common value under FASE.

Upload a drawing with typical data.  Right now all tou have in your drawing is the block definition.

ymg

Hi ymg,
Thanks for reply.
I wish to count the blocks with the same value under TIT.
« Last Edit: January 08, 2014, 01:27:36 PM by antistar »

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Counting Block TAG per Block TAG
« Reply #4 on: January 08, 2014, 12:52:55 PM »
You can use FIND to accomplish this.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

ymg

  • Guest
Re: Counting Block TAG per Block TAG
« Reply #5 on: January 08, 2014, 01:00:23 PM »
Another option get this http://lee-mac.com/macatt.html

This will read the attributes and Export them in an Excel Workbook.

Then you can sort them any which way.

ymg

antistar

  • Guest
Re: Counting Block TAG per Block TAG
« Reply #6 on: January 08, 2014, 01:30:43 PM »
Another option get this http://lee-mac.com/macatt.html

This will read the attributes and Export them in an Excel Workbook.

Then you can sort them any which way.

ymg

ymg,
See DWG attached.
« Last Edit: January 08, 2014, 01:45:10 PM by antistar »

Krushert

  • Seagull
  • Posts: 13679
  • FREE BEER Tomorrow!!
Re: Counting Block TAG per Block TAG
« Reply #7 on: January 08, 2014, 03:12:56 PM »
The DataExtraction command will not work in a singular action.  It pulls the data from the attributes but then you would have to dump the data out to Excel  and sort there..
I + XI = X is true ...  ... if you change your perspective.

I no longer CAD or Model, I just hang out here picking up the empties beer cans

ymg

  • Guest
Re: Counting Block TAG per Block TAG
« Reply #8 on: January 09, 2014, 12:21:47 AM »
antistar,

Here goes.  The routine will do your count and creates an Autocad Table.
Size of the Table is dependant on Var TEXTSIZE.
As the routine completes Move command is initiated with the Table selected,
You drag it to its position.

Contents of the Table is also sent to the clipboard ready to be pasted
in any other applications.

Code - Auto/Visual Lisp: [Select]
  1. ;; str2lst           by Gilles Chanteau                                       ;
  2. ;; Transforme un chaine avec séparateur en liste de chaines                   ;
  3. ;; Modified to remove Leading and Trailing spaces                             ;
  4. ;; Arguments                                                                  ;
  5. ;; str : la chaine à transformer en liste                                     ;
  6. ;; sep : le séparateur                                                        ;
  7. ;;                                                                            ;
  8. ;; Exemples                                                                   ;
  9. ;; (str2lst "a b c" " ") -> ("a" "b" "c")                                     ;
  10. ;; (str2lst "1,2,3" ",") -> ("1" "2" "3")                                     ;
  11. ;; (mapcar 'read (str2lst "1,2,3" ",")) -> (1 2 3)                            ;
  12.  
  13. (defun str2lst (str sep / pos)
  14.   (mapcar '(lambda (s) (vl-string-trim " " s))
  15.      (if (setq pos (vl-string-search sep str))
  16.         (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep))
  17.         (list str)
  18.      )
  19.   )
  20. )
  21.  
  22. ;; getblkename       by ymg                                                   ;
  23. ;;                                                                            ;
  24. ;; Original Code by Tim Wiley                                                 ;
  25. ;; Argument: Block Name                                                       ;
  26. ;;  Returns: list of enames Block in Drawing                                  ;
  27.  
  28. (defun getblkename (blkname / blkl)
  29.        (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")          
  30.                 (= (vlax-get-property obj                
  31.                       (if (vlax-property-available-p obj 'effectivename)
  32.                          'effectivename
  33.                          'name
  34.                        )            
  35.                    )                  
  36.                    blkname
  37.                 )
  38.            )
  39.            (setq blkl (cons (vlax-vla-object->ename obj) blkl))
  40.        )
  41.    )
  42.    blkl
  43. )  
  44.  
  45. ;; Count Items  -  Lee Mac                                                    ;
  46. ;; Returns a list of dotted pairs detailing the number of                     ;
  47. ;; occurrences of each item in a supplied list.                               ;
  48.  
  49. (defun countitems ( l / c x )
  50.     (if (setq x (car l))
  51.         (progn
  52.             (setq c (length l)
  53.                   l (vl-remove x (cdr l))
  54.             )
  55.             (cons (cons x (- c (length l))) (countItems l))
  56.         )
  57.     )
  58. )
  59.  
  60. ;;; strtoclipboard                                                            ;
  61. ;;; Not too sure of the origin of that one maybe ASMI                         ;
  62.  
  63. (defun strtoclipboard (str / html)
  64.    (if (= 'STR (type str))
  65.       (vlax-invoke
  66.            (vlax-get
  67.                 (vlax-get (setq html (vlax-create-object "htmlfile")) 'ParentWindow)
  68.                      'ClipBoardData
  69.            )
  70.            'setData "Text" str
  71.       )
  72.    )
  73.    
  74. )
  75.  
  76. (defun in_range (s e i)
  77.   (if (or (and (> i 0) (< s e)) (and (< i 0) (> s e)))
  78.     (cons s (in_range (+ i s) e i))
  79.   )
  80. )
  81.  
  82. ;;****************************************************************************;
  83. ;; mktable      by ymg                                                        ;
  84. ;;                                                                            ;
  85. ;; Argument: title    Title for table                                         ;
  86. ;;           headerl  A list of header for column of Table                    ;
  87. ;;           list     list of list containing the data                        ;
  88. ;;                                                                            ;
  89. ;; Returns: Will create a table on the current layer and will return,         ;
  90. ;;          the object table.                                                 ;
  91. ;;                                                                            ;
  92. ;; For those who wonders ** is a dummy variable.                              ;
  93. ;;                                                                            ;
  94. ;;****************************************************************************;
  95.  
  96. (defun mktable (title headerl lst th / ** mspace pt tbl nrow ncol row col vc)
  97.   (setq  lst (cons headerl lst)
  98.         nrow (+ (length lst) 1)
  99.         ncol (length (car lst))  
  100.           vc (getvar 'viewctr)          
  101.           pt (vlax-make-safearray vlax-vbDouble '(0 . 2))
  102.           ** (vlax-safearray-fill pt vc)
  103.          tbl (vla-addtable mspace pt nrow ncol (* 2 th) (* 25 th))
  104.           ** (vla-setcelltextheight tbl 0 0 th)
  105.           ** (vla-settext tbl 0 0 title)        
  106.   )
  107.  
  108.   (setq row 1 col 0)
  109.   (foreach item lst
  110.       (foreach val item
  111.           (vla-setcelltextheight tbl row col th)
  112.           (vla-setcellalignment tbl row col acTopCenter)
  113.           (vla-settext tbl row col val)          
  114.           (setq col (1+ col))
  115.       )
  116.       (vla-setcellalignment tbl row (- col 1) acTopLeft)
  117.       (setq row (1+ row) col 0)    
  118.   )
  119.   tbl
  120. )
  121.  
  122. ;; sd                by ymg                                                   ;
  123. ;; Creates a COUNT list and a table detailing how many occurences             ;
  124. ;; of FASE attributes for each TIT attributes.                                ;
  125. ;; COUNT list is also transferred to the Window Clipboard,                    ;
  126. ;; ready to be pasted.                                                        ;
  127.  
  128. (defun c:sd ( / attl bl cb colwl count en enl lf n  sep tbl tit txth)
  129.  
  130.  
  131.   ;; bl is a list of ename for Block  SteelDim"                               ;
  132.   (setq bl (getblkename "SteelDim"))
  133.   (setq attl nil)
  134.   (foreach e bl      
  135.      (setq en (entnext e)
  136.         enl (entget en)
  137.      )      
  138.      (while (= (cdr (assoc 0 enl)) "ATTRIB")
  139.         (cond
  140.             ((= (cdr (assoc 2 enl)) "TIT") (setq tit (cdr (assoc 1 enl))))            
  141.             ((= (cdr (assoc 2 enl)) "FASE")  (setq attl (cons (list tit (cdr (assoc 1 enl))) attl)))                                          
  142.         )        
  143.         (setq  en (entnext en)        
  144.               enl (entget  en)
  145.         )  
  146.      )
  147.   )
  148.  
  149.  
  150.   ;; attl is a list of list  '((TIT FASE)... )                                ;
  151.   ;; Now we count each occurrence of a given pair                             ;
  152.  
  153.   (setq count (countitems attl))
  154.  
  155.   ;; Re-format attl to be a list of list ((TIT QTY FASE)...)                  ;
  156.   (setq attl nil)
  157.   (foreach item count
  158.      (setq attl (cons (list (caar item) (itoa (cdr item)) (cadar item)) attl))
  159.   )
  160.  
  161.   ;; Sort on FASE then on TIT                                                 ;
  162.   (setq attl (vl-sort attl (function (lambda (a b) (< (caddr a) (caddr b)))))
  163.         attl (vl-sort attl (function (lambda (a b) (< (car a) (car b)))))
  164.   )  
  165.  
  166.   ;; Creates The COUNT Table                                                  ;
  167.  
  168.   (setq txth  (getvar 'TEXTSIZE)
  169.          tbl  (mktable "COUNT" '("TIT" "QTY" "FASE") attl txth)
  170.         colwl (list (* txth 10) (* txth 5) (* 15 txth))
  171.   )
  172.        
  173.   ; Adjust Column Width of the Table.                                         ;
  174.   (setq n -1)      
  175.   (foreach col colwl
  176.       (vla-setcolumnwidth tbl (setq n (1+ n)) col)
  177.   )  
  178.  
  179.   ; Put the whole COUNT list in Variable cb and Send to Clipboard             ;
  180.   (setq   sep "\t"
  181.            lf "\n"
  182.            cb (strcat "COUNT" lf "TIT" sep "QTY" sep "FASE")
  183.   )
  184.        
  185.   (foreach l attl
  186.      (setq cb (strcat cb lf))
  187.      (foreach i l
  188.         (setq cb (strcat cb i sep))
  189.      )
  190.   )
  191.   (strtoclipboard cb)
  192.  
  193.   ;; Initiated Move of the table and awaits destination point                 ;
  194.   (command "_MOVE" (vlax-vla-object->ename tbl) "" (getvar 'viewctr) pause)
  195.  
  196.   (princ)
  197. )
  198. (princ "\nSteel Dim.....Start with SD")
  199.  

antistar

  • Guest
Re: Counting Block TAG per Block TAG
« Reply #9 on: January 09, 2014, 07:01:17 AM »
antistar,

Here goes.  The routine will do your count and creates an Autocad Table.
Size of the Table is dependant on Var TEXTSIZE.
As the routine completes Move command is initiated with the Table selected,
You drag it to its position.

Contents of the Table is also sent to the clipboard ready to be pasted
in any other applications.

Code - Auto/Visual Lisp: [Select]
  1. ;; str2lst           by Gilles Chanteau                                       ;
  2. ;; Transforme un chaine avec séparateur en liste de chaines                   ;
  3. ;; Modified to remove Leading and Trailing spaces                             ;
  4. ;; Arguments                                                                  ;
  5. ;; str : la chaine à transformer en liste                                     ;
  6. ;; sep : le séparateur                                                        ;
  7. ;;                                                                            ;
  8. ;; Exemples                                                                   ;
  9. ;; (str2lst "a b c" " ") -> ("a" "b" "c")                                     ;
  10. ;; (str2lst "1,2,3" ",") -> ("1" "2" "3")                                     ;
  11. ;; (mapcar 'read (str2lst "1,2,3" ",")) -> (1 2 3)                            ;
  12.  
  13. (defun str2lst (str sep / pos)
  14.   (mapcar '(lambda (s) (vl-string-trim " " s))
  15.      (if (setq pos (vl-string-search sep str))
  16.         (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep))
  17.         (list str)
  18.      )
  19.   )
  20. )
  21.  
  22. ;; getblkename       by ymg                                                   ;
  23. ;;                                                                            ;
  24. ;; Original Code by Tim Wiley                                                 ;
  25. ;; Argument: Block Name                                                       ;
  26. ;;  Returns: list of enames Block in Drawing                                  ;
  27.  
  28. (defun getblkename (blkname / blkl)
  29.        (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")          
  30.                 (= (vlax-get-property obj                
  31.                       (if (vlax-property-available-p obj 'effectivename)
  32.                          'effectivename
  33.                          'name
  34.                        )            
  35.                    )                  
  36.                    blkname
  37.                 )
  38.            )
  39.            (setq blkl (cons (vlax-vla-object->ename obj) blkl))
  40.        )
  41.    )
  42.    blkl
  43. )  
  44.  
  45. ;; Count Items  -  Lee Mac                                                    ;
  46. ;; Returns a list of dotted pairs detailing the number of                     ;
  47. ;; occurrences of each item in a supplied list.                               ;
  48.  
  49. (defun countitems ( l / c x )
  50.     (if (setq x (car l))
  51.         (progn
  52.             (setq c (length l)
  53.                   l (vl-remove x (cdr l))
  54.             )
  55.             (cons (cons x (- c (length l))) (countItems l))
  56.         )
  57.     )
  58. )
  59.  
  60. ;;; strtoclipboard                                                            ;
  61. ;;; Not too sure of the origin of that one maybe ASMI                         ;
  62.  
  63. (defun strtoclipboard (str / html)
  64.    (if (= 'STR (type str))
  65.       (vlax-invoke
  66.            (vlax-get
  67.                 (vlax-get (setq html (vlax-create-object "htmlfile")) 'ParentWindow)
  68.                      'ClipBoardData
  69.            )
  70.            'setData "Text" str
  71.       )
  72.    )
  73.    
  74. )
  75.  
  76. (defun in_range (s e i)
  77.   (if (or (and (> i 0) (< s e)) (and (< i 0) (> s e)))
  78.     (cons s (in_range (+ i s) e i))
  79.   )
  80. )
  81.  
  82. ;;****************************************************************************;
  83. ;; mktable      by ymg                                                        ;
  84. ;;                                                                            ;
  85. ;; Argument: title    Title for table                                         ;
  86. ;;           headerl  A list of header for column of Table                    ;
  87. ;;           list     list of list containing the data                        ;
  88. ;;                                                                            ;
  89. ;; Returns: Will create a table on the current layer and will return,         ;
  90. ;;          the object table.                                                 ;
  91. ;;                                                                            ;
  92. ;; For those who wonders ** is a dummy variable.                              ;
  93. ;;                                                                            ;
  94. ;;****************************************************************************;
  95.  
  96. (defun mktable (title headerl lst th / ** mspace pt tbl nrow ncol row col vc)
  97.   (setq  lst (cons headerl lst)
  98.         nrow (+ (length lst) 1)
  99.         ncol (length (car lst))  
  100.           vc (getvar 'viewctr)          
  101.           pt (vlax-make-safearray vlax-vbDouble '(0 . 2))
  102.           ** (vlax-safearray-fill pt vc)
  103.          tbl (vla-addtable mspace pt nrow ncol (* 2 th) (* 25 th))
  104.           ** (vla-setcelltextheight tbl 0 0 th)
  105.           ** (vla-settext tbl 0 0 title)        
  106.   )
  107.  
  108.   (setq row 1 col 0)
  109.   (foreach item lst
  110.       (foreach val item
  111.           (vla-setcelltextheight tbl row col th)
  112.           (vla-setcellalignment tbl row col acTopCenter)
  113.           (vla-settext tbl row col val)          
  114.           (setq col (1+ col))
  115.       )
  116.       (vla-setcellalignment tbl row (- col 1) acTopLeft)
  117.       (setq row (1+ row) col 0)    
  118.   )
  119.   tbl
  120. )
  121.  
  122. ;; sd                by ymg                                                   ;
  123. ;; Creates a COUNT list and a table detailing how many occurences             ;
  124. ;; of FASE attributes for each TIT attributes.                                ;
  125. ;; COUNT list is also transferred to the Window Clipboard,                    ;
  126. ;; ready to be pasted.                                                        ;
  127.  
  128. (defun c:sd ( / attl bl cb colwl count en enl lf n  sep tbl tit txth)
  129.  
  130.  
  131.   ;; bl is a list of ename for Block  SteelDim"                               ;
  132.   (setq bl (getblkename "SteelDim"))
  133.   (setq attl nil)
  134.   (foreach e bl      
  135.      (setq en (entnext e)
  136.         enl (entget en)
  137.      )      
  138.      (while (= (cdr (assoc 0 enl)) "ATTRIB")
  139.         (cond
  140.             ((= (cdr (assoc 2 enl)) "TIT") (setq tit (cdr (assoc 1 enl))))            
  141.             ((= (cdr (assoc 2 enl)) "FASE")  (setq attl (cons (list tit (cdr (assoc 1 enl))) attl)))                                          
  142.         )        
  143.         (setq  en (entnext en)        
  144.               enl (entget  en)
  145.         )  
  146.      )
  147.   )
  148.  
  149.  
  150.   ;; attl is a list of list  '((TIT FASE)... )                                ;
  151.   ;; Now we count each occurrence of a given pair                             ;
  152.  
  153.   (setq count (countitems attl))
  154.  
  155.   ;; Re-format attl to be a list of list ((TIT QTY FASE)...)                  ;
  156.   (setq attl nil)
  157.   (foreach item count
  158.      (setq attl (cons (list (caar item) (itoa (cdr item)) (cadar item)) attl))
  159.   )
  160.  
  161.   ;; Sort on FASE then on TIT                                                 ;
  162.   (setq attl (vl-sort attl (function (lambda (a b) (< (caddr a) (caddr b)))))
  163.         attl (vl-sort attl (function (lambda (a b) (< (car a) (car b)))))
  164.   )  
  165.  
  166.   ;; Creates The COUNT Table                                                  ;
  167.  
  168.   (setq txth  (getvar 'TEXTSIZE)
  169.          tbl  (mktable "COUNT" '("TIT" "QTY" "FASE") attl txth)
  170.         colwl (list (* txth 10) (* txth 5) (* 15 txth))
  171.   )
  172.        
  173.   ; Adjust Column Width of the Table.                                         ;
  174.   (setq n -1)      
  175.   (foreach col colwl
  176.       (vla-setcolumnwidth tbl (setq n (1+ n)) col)
  177.   )  
  178.  
  179.   ; Put the whole COUNT list in Variable cb and Send to Clipboard             ;
  180.   (setq   sep "\t"
  181.            lf "\n"
  182.            cb (strcat "COUNT" lf "TIT" sep "QTY" sep "FASE")
  183.   )
  184.        
  185.   (foreach l attl
  186.      (setq cb (strcat cb lf))
  187.      (foreach i l
  188.         (setq cb (strcat cb i sep))
  189.      )
  190.   )
  191.   (strtoclipboard cb)
  192.  
  193.   ;; Initiated Move of the table and awaits destination point                 ;
  194.   (command "_MOVE" (vlax-vla-object->ename tbl) "" (getvar 'viewctr) pause)
  195.  
  196.   (princ)
  197. )
  198. (princ "\nSteel Dim.....Start with SD")
  199.  

Hi ymg,
Thanks for your reply and for all the work done to help me.
His routine is almost what I need.
Please see attached file.
« Last Edit: January 09, 2014, 07:59:03 AM by antistar »

ymg

  • Guest
Re: Counting Block TAG per Block TAG
« Reply #10 on: January 09, 2014, 10:15:17 AM »
antistar,

Eveything is there,  in order to do it.

if you need to modify the formatting, be my guess and do it.

This is not a Supermarket, but a Forum to learn.

ymg

antistar

  • Guest
Re: Counting Block TAG per Block TAG
« Reply #11 on: January 10, 2014, 07:25:58 AM »
Thanks krushert, ymg and ronjonp for your explanations.

Best regards.