Summarizing all blocks by their name into a table or a list.

[vladimir.karatsupa982899]

Can someone help me figure out a way to summarize all blocks located in active paper space by their names and then create (somewhere on the sheet) a summary list organized by block name and quantity of each block.

I know how to organize all of the blocks into a selection set, but I am stuck after that...please help.

Thank you

[Tharwat]

Try this ...

(defun c:test (/ ss l)
  ;;	Tharwat 22. May. 2014		;;
  (if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 410 (getvar 'CTAB)))))
    ((lambda (i / sn nm it)
       (while (setq sn (ssname ss (setq i (1+ i))))
         (if (setq it (assoc (setq nm (vla-get-effectivename
                                        (vlax-ename->vla-object sn)
                                      )
                             )
                             l
                      )
             )
           (setq l (subst (list (car it) (1+ (cadr it))) it l))
           (setq l (cons (list nm 1) l))
         )
       )
     )
      -1
    )
  )
  (if l
    (progn
      (foreach x l
        (print x)
      )
      (textscr)
    )
  )
  (princ)
)(vl-load-com)

[vladimir.karatsupa982899]

Wonderful, this code works...it prints to the screen, I'll just have to tweak the code to make it print a list or a table on the sheet somewhere in paper space.

Thank you
PS. Could you explain how this code works for newbies like myself.

[Tharwat]

Try this .

(defun c:Test (/ WriteAndSet columns e ss l hgt inc ins rows p r tbl)
  ;;	Tharwat 23. May. 2014		;;
  (if (setq ss (ssget "_X"
                      (list '(0 . "INSERT") (cons 410 (getvar 'CTAB)))
               )
      )
    ((lambda (i / sn nm it)
       (while (setq sn (ssname ss (setq i (1+ i))))
         (if (setq it (assoc (setq nm (vla-get-effectivename
                                        (vlax-ename->vla-object sn)
                                      )
                             )
                             l
                      )
             )
           (setq l (subst (list (car it) (1+ (cadr it))) it l))
           (setq l (cons (list nm 1) l))
         )
       )
     )
      -1
    )
  )
  (if l
    (progn
      (setq hgt
             (if
               (zerop
                 (cdr
                   (assoc
                     40
                     (setq
                       e (entget (tblobjname "STYLE" (getvar 'textstyle)))
                     )
                   )
                 )
               )
                (* (getvar 'textsize) 2.0)
                (* (cdr (assoc 40 e)) 2.0)
             )
            columns 2
            r 2
      )
      (if (setq ins (getpoint "\n Specify Table Location :"))
        (progn
          (setq
            tbl (vla-addtable
                  (vlax-get
                    (vla-get-activelayout
                      (vla-get-activedocument (vlax-get-acad-object))
                    )
                    'BLOCK
                  )
                  (vlax-3d-point ins)
                  (+ (length l) 2)
                  columns
                  (* hgt 1.5)
                  (* hgt 1.5)
                )
          )
          (setq inc -1)
          (repeat 2
            (vla-setcolumnwidth tbl (setq inc (1+ inc)) (* hgt 5.))
          )
          (vla-setrowheight tbl 0 (* hgt 1.5))
          (vla-setrowheight tbl 1 (* hgt 1.5))
          (vla-settext
            tbl
            0
            0
            (strcat "Blocks Quantity")
          )
          (vla-setcolumnwidth tbl 0 (* hgt 10.))
          (vla-setcolumnwidth tbl 1 (* hgt 4.5))
          (vla-settext tbl 1 0 "Block Name")
          (vla-settext tbl 1 1 "QTY")
        )
      )
      (defun WriteAndSet (col row string)
        (vla-settext tbl row col string)
        (vla-setcellalignment tbl row col acMiddleCenter)
      )
      (foreach x l
        (WriteAndSet 0 r (car x))
        (WriteAndSet 1 r (cadr x))
        (setq r (1+ r))
      )
    )
  )
  (princ)
)
(vl-load-com)

[vladimir.karatsupa982899]

Do you think the same can be done by using MTEXT or TEXT instead of blocks?

[Tharwat]

Do you think the same can be done by using MTEXT or TEXT instead of blocks?

At the mean time , I can say yes but it depends on what you are after as long as you did not give enough information .

Did not you try the last routine that I wrote just for you ?

[vladimir.karatsupa982899]

How can I modify the TableFontStyle in tis routine?
I tried creating a text style (xyz) and then referencing the style in (tblobjname "STYLE" "xyz") but nothing seems to change. Why is that so. I would like the text style xyz to be arial with the height of the text predetermined in text style xyz

Please help

Try this .

(defun c:Test (/ WriteAndSet columns e ss l hgt inc ins rows p r tbl)
  ;;	Tharwat 23. May. 2014		;;
  
  (if l
    (progn
      (setq hgt
             (if
               (zerop
                 (cdr
                   (assoc
                     40
                     (setq
                       e (entget (tblobjname "STYLE" (getvar 'textstyle)))
                     )
                   )
                 )
               )
                (* (getvar 'textsize) 2.0)
                (* (cdr (assoc 40 e)) 2.0)
             )
            columns 2
            r 2
      )
      (if (setq ins (getpoint "\n Specify Table Location :"))
        (progn
          (setq
            tbl (vla-addtable
                  (vlax-get
                    (vla-get-activelayout
                      (vla-get-activedocument (vlax-get-acad-object))
                    )
                    'BLOCK
                  )
                  (vlax-3d-point ins)
                  (+ (length l) 2)
                  columns
                  (* hgt 1.5)
                  (* hgt 1.5)
                )
          )
          (setq inc -1)
          (repeat 2
            (vla-setcolumnwidth tbl (setq inc (1+ inc)) (* hgt 5.))
          )
          (vla-setrowheight tbl 0 (* hgt 1.5))
          (vla-setrowheight tbl 1 (* hgt 1.5))
          (vla-settext
            tbl
            0
            0
            (strcat "Blocks Quantity")
          )
          (vla-setcolumnwidth tbl 0 (* hgt 10.))
          (vla-setcolumnwidth tbl 1 (* hgt 4.5))
          (vla-settext tbl 1 0 "Block Name")
          (vla-settext tbl 1 1 "QTY")
        )
      )
      (defun WriteAndSet (col row string)
        (vla-settext tbl row col string)
        (vla-setcellalignment tbl row col acMiddleCenter)
      )
      (foreach x l
        (WriteAndSet 0 r (car x))
        (WriteAndSet 1 r (cadr x))
        (setq r (1+ r))
      )
    )
  )
  (princ)
)
(vl-load-com)