Block Count without Data extraction

[asos2000]

LEE

As expected, very good routine.

could a Block Preview be added next to each block?

[Lee Mac]

LEE As expected, very good routine.

 

Thanks Asos

 

could a Block Preview be added next to each block?

 

With difficulty

[stevsmith]

Thanks Asos

With difficulty

 

 

An I thought you liked a challenge mate. :wink:

[Lee Mac]

An I thought you liked a challenge mate.

 

That I do - but not this time

[alanjt]

what about QSELECT? Select block by name and F2 or use the properties palette to see how many were selected.

Not sure why I just thought about this, but I wanted to add it for archival purposes. You could also use SSX (Express Tool).

[Lee Mac]

Nice one Alan, didn't know about that one.

[WtaDude0822]

Another method is to use the SSX command. It's been around a long time, but not many people seem to know about it. Type SSX at the command prompt and select your block (or line, arc, text, etc. - any entity basically). Just hit return after selecting...now, use a move command (or erase - anything that prompts you to select objects) and type p (for previous) at the select objects prompt. That will give you a count of all blocks (specifically the one you just selected) in the drawing. SSX is a filtering lisp that's been in Autocad since at least R12, maybe longer. It's great for selecting many "like" objects (be it text, a linetype, a line color, blocks, etc.) at one time. This is an old school way of doing it, but is simple and still comes in very handy.

 

Sorry, I didn't page through all responses...someone already suggested SSX

[asos2000]

but I think that

the way of alanjt to give a quick message box with number for each block is good

and the way of LEE to give a table is good too.

BUt asking LEE to chalange himself (at spare time) and add a block preview front of each block

 

Cheers

[alanjt]

Nice one Alan, didn't know about that one.

It's an oldie. I found it back in my r14 days when I was 18 or 19.

 

Another method is to use the SSX command. It's been around a long time, but not many people seem to know about it. Type SSX at the command prompt and select your block (or line, arc, text, etc. - any entity basically). Just hit return after selecting...now, use a move command (or erase - anything that prompts you to select objects) and type p (for previous) at the select objects prompt. That will give you a count of all blocks (specifically the one you just selected) in the drawing. SSX is a filtering lisp that's been in Autocad since at least R12, maybe longer. It's great for selecting many "like" objects (be it text, a linetype, a line color, blocks, etc.) at one time. This is an old school way of doing it, but is simple and still comes in very handy.

 

Sorry, I didn't page through all responses...someone already suggested SSX

LoL, look 2 posts prior to yours.

 

but I think that

the way of alanjt to give a quick message box with number for each block is good

Quick and dirty FTW. :wink:

[stevsmith]

but I think that

the way of alanjt to give a quick message box with number for each block is good

and the way of LEE to give a table is good too.

BUt asking LEE to chalange himself (at spare time) and add a block preview front of each block

 

Cheers

 

haha, I'm sure that going by my previous history Lee can appreciate my sarcastic tone and humor.

 

:wink:

[Lee Mac]

haha, I'm sure that going by my previous history Lee can appreciate my sarcastic tone and humor.

 

:wink:

 

I wouldn't expect anything less

[Lee Mac]

An update, as per the counterpart thread over at theSwamp:

 

;; Block Counter (Lee Mac)
;; Will produce a report and table of the number of each block in the drawing.
;; Includes Dyn Blocks, excludes Xrefs - and yes, I know there is BCount.

(defun c:BNum ( / blocks bLst rLen )
 (vl-load-com)
 ;; Lee Mac  ~  21.04.10

 (setq bLst
   (mapcar
     (function
       (lambda ( block )
         (list block 0)
       )
     )
     (BlockList 125)
   )
 ) 

 (setq bLst
   (mapcar
     (function
       (lambda ( item )
         (list (car item)
           (itoa (cadr item))
         )
       )
     )
     (vl-remove-if
       (function
         (lambda ( item )
           (zerop (cadr item))
         )
       )
       (vlax-for lay
         (vla-get-layouts
           (vla-get-ActiveDocument
             (vlax-get-acad-object)
           )
         )    
         (vlax-for obj (vla-get-Block lay)
           (if (and (eq "AcDbBlockReference" (vlax-get-property obj 'ObjectName))
                    (not (isXRef obj)))
             (progn
               (setq a (assoc (BlockName obj) bLst))
               (setq bLst
                 (subst
                   (list (car a) (1+ (cadr a))) a bLst
                 )
               )
             )
           )
           bLst
         )
       )
     )
   )
 )

 (setq rLen
   (+ 3
     (apply (function max)
       (cons 5
         (mapcar (function strlen)
           (mapcar (function cadr) bLst)
         )
       )
     )
   )
 )

 (mapcar
   (function
     (lambda ( item )
       (princ
         (strcat "\n"
           (PadRight (car  item) "."   40) "|"
           (PadLeft  (cadr item) "." rLen)
         )
       )
     )
   )
   (setq bLst
     (cons
       '("Block Name" "Count")
       (cons
         (list
           (PadRight "" "-"   40)
           (PadLeft  "" "-" rLen)
         )
         (append
           (vl-sort bLst
             (function
               (lambda ( a b )
                 (< (car a) (car b))
               )
             )
           )
           (list
             (list
               (PadRight "" "-" 40)
               (PadLeft  "" "-" rLen)
             )
           )
         )
       )
     )
   )
 )

 (initget "Yes No")
 (if (/= "No" (getkword "\nTable? <Yes> : "))
   (GrMove
     (AddTable
       (GetActiveSpace
         (vla-get-ActiveDocument
           (vlax-get-acad-object)
         )
       )
       (getvar 'VIEWCTR) "Block Data"
       (RemoveItems bLst (list 1 (1- (length bLst))))
     )
     'InsertionPoint "\nPlace Table... " 0
   )
 )
 
 (princ)
)

(defun BlockName ( obj )
 (vlax-get-property obj
   (if (vlax-property-available-p obj 'EffectiveName)
     'EffectiveName 'Name
   )
 )
)

(defun isXref ( obj )
 (eq :vlax-true
   (vlax-get-property
     (Itemp
       (setq blocks
         (cond (blocks)
           (
             (vla-get-blocks
               (vla-get-ActiveDocument
                 (vlax-get-acad-object)
               )
             )
           )
         )
       )
       (BlockName obj)
     )
     'isXRef
   )
 )
)

(defun BlockList ( ignore / def lst )
 (while (setq def (tblnext "BLOCK" (null def)))
   (if (zerop (boole 1 ignore (cdr (assoc 70 def))))
     (setq lst (cons (cdr (assoc 2 def)) lst))
   )
 )
 lst
)

(defun GetActiveSpace ( doc )
 (vlax-get-property doc
   (if (or (eq acModelSpace (vla-get-ActiveSpace doc))
           (eq :vlax-true   (vla-get-MSpace doc)))
     'ModelSpace 'PaperSpace
   )
 )
)

(defun RemoveItems ( lst items )
 (  (lambda ( item )
      (vl-remove-if
        (function
          (lambda ( x )
            (vl-position
              (setq item (1+ item)) items
            )
          )
        )
        lst
      )
    )
   -1
 )
)

(defun Itemp ( coll item )
 (if
   (not
     (vl-catch-all-error-p
       (setq item
         (vl-catch-all-apply
           (function vla-item) (list coll item)
         )
       )
     )
   )
   item
 )
)

(defun AddTable ( block pt title data / tObj tStyle )
 (setq tStyle (GetTableStyle (getvar 'CTABLESTYLE)))  
 (vlax-put-property
   (setq tObj
     (vla-AddTable block
       (vlax-3D-point pt) (1+ (length data)) (length (car data))
       (* 1.8 (vla-getTextHeight tStyle acDataRow))
       (* 0.8
         (apply (function max)
           (mapcar (function strlen)
             (apply (function append) data)
           )
         )
          (vla-getTextHeight tStyle acDataRow)
       )
     )
   )
   'StyleName (getvar 'CTABLESTYLE)
 )

 (vla-SetText tObj 0 0 title)

 (
   (lambda ( row )
     (mapcar
       (function
         (lambda ( rowitem ) (setq row (1+ row))
           (
             (lambda ( column )
               (mapcar
                 (function
                   (lambda ( item )
                     (vla-SetText tObj row
                       (setq column (1+ column)) item
                     )
                   )
                 )
                 rowitem
               )
             )
             -1
           )
         )
       )
       data
     )
   )
   0
 )
 tObj
)

(defun GetTableStyle ( Name )
 (if (setq Dict
       (Itemp
         (vla-get-Dictionaries
           (vla-get-ActiveDocument
             (vlax-get-acad-object)
           )
         )
         "ACAD_TABLESTYLE"
       )
     )
   (Itemp Dict Name)
 )
)

(defun GrMove ( obj prop msg cur / gr data )
 (if (vlax-property-available-p obj prop)
   (progn
     (princ msg)
     (while
       (and (= 5 (car (setq gr (grread t 13 cur))))
            (listp (setq data (cadr gr))))

       (vlax-put-property obj prop (vlax-3D-point data))
     )
     data
   )
 )
)

(defun TidyString ( str len )
 (if (> (strlen str) len)
   (strcat
     (substr str 1 (- len 3)) "..."
   )
   str
 )
)

(defun PadRight ( str char len )
 (while (< (strlen str) len)
   (setq str (strcat str char))
 )
 str
)


(defun PadLeft ( str char len )
 (while (< (strlen str) len)
   (setq str (strcat char str))
 )
 str
)

[asos2000]

Lee

please is there no time to add block preview next to each block at table?

[Lee Mac]

please is there no time to add block preview next to each block at table?

 

Try this:

 

;; Block Counter (Lee Mac)
;; Will produce a report and table of the number of each block in the drawing.
;; Includes Dyn Blocks, excludes Xrefs - and yes, I know there is BCount.

(defun c:BNum ( / blks bLst rLen )
 (vl-load-com)
 ;; Lee Mac  ~  21.04.10

 (setq blks
   (vla-get-Blocks
     (vla-get-ActiveDocument
       (vlax-get-acad-object)
     )
   )
 )

 (setq bLst
   (mapcar
     (function
       (lambda ( block )
         (list block 0)
       )
     )
     (BlockList 125)
   )
 ) 

 (setq bLst
   (mapcar
     (function
       (lambda ( item )
         (list (TidyString (car item) 40)
           (itoa (cadr item))
         )
       )
     )
     (vl-remove-if
       (function
         (lambda ( item )
           (zerop (cadr item))
         )
       )
       (vlax-for lay
         (vla-get-layouts
           (vla-get-ActiveDocument
             (vlax-get-acad-object)
           )
         )    
         (vlax-for obj (vla-get-Block lay)
           (if (and (eq "AcDbBlockReference" (vlax-get-property obj 'ObjectName))
                    (not (isXRef obj)))
             (progn
               (setq a (assoc (BlockName obj) bLst))
               (setq bLst
                 (subst
                   (list (car a) (1+ (cadr a))) a bLst
                 )
               )
             )
           )
           bLst
         )
       )
     )
   )
 )

 (setq rLen
   (+ 3
     (apply (function max)
       (cons 5
         (mapcar (function strlen)
           (mapcar (function cadr) bLst)
         )
       )
     )
   )
 )

 (mapcar
   (function
     (lambda ( item )
       (princ
         (strcat "\n"
           (PadRight (car  item) "."   40) "|"
           (PadLeft  (cadr item) "." rLen)
         )
       )
     )
   )
   (setq bLst
     (cons
       '("Block Name" "Count")
       (cons
         (list
           (PadRight "" "-"   40)
           (PadLeft  "" "-" rLen)
         )
         (append
           (vl-sort bLst
             (function
               (lambda ( a b )
                 (< (car a) (car b))
               )
             )
           )
           (list
             (list
               (PadRight "" "-" 40)
               (PadLeft  "" "-" rLen)
             )
           )
         )
       )
     )
   )
 )

 (initget "Yes No")
 (if (/= "No" (getkword "\nTable? <Yes> : "))
   (GrMove
     (AddTable
       (GetActiveSpace
         (vla-get-ActiveDocument
           (vlax-get-acad-object)
         )
       )
       (getvar 'VIEWCTR) "Block Data"
       (RemoveItems bLst (list 1 (1- (length bLst))))
     )
     'InsertionPoint "\nPlace Table... " 0
   )
 )
 
 (princ)
)

(defun GetObjectID ( obj )
 (if (Is64Bit)
   (vlax-invoke-method
     (setq Utility
       (cond ( Utility )
         (
           (vla-get-Utility
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
     )
     'GetObjectIdString obj :vlax-false
   )
   (itoa (vla-get-Objectid obj))
 )
)

(defun BlockName ( obj )
 (vlax-get-property obj
   (if (vlax-property-available-p obj 'EffectiveName)
     'EffectiveName 'Name
   )
 )
)

(defun isXref ( obj )
 (eq :vlax-true
   (vlax-get-property
     (Itemp
       (setq blks
         (cond (blks)
           (
             (vla-get-blocks
               (vla-get-ActiveDocument
                 (vlax-get-acad-object)
               )
             )
           )
         )
       )
       (BlockName obj)
     )
     'isXRef
   )
 )
)

(defun Is64Bit nil
 (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE")))

(defun BlockList ( ignore / def lst )
 (while (setq def (tblnext "BLOCK" (null def)))
   (if (zerop (boole 1 ignore (cdr (assoc 70 def))))
     (setq lst (cons (cdr (assoc 2 def)) lst))
   )
 )
 lst
)

(defun GetActiveSpace ( doc )
 (vlax-get-property doc
   (if (or (eq acModelSpace (vla-get-ActiveSpace doc))
           (eq :vlax-true   (vla-get-MSpace doc)))
     'ModelSpace 'PaperSpace
   )
 )
)

(defun RemoveItems ( lst items )
 (  (lambda ( item )
      (vl-remove-if
        (function
          (lambda ( x )
            (vl-position
              (setq item (1+ item)) items
            )
          )
        )
        lst
      )
    )
   -1
 )
)

(defun Itemp ( coll item )
 (if
   (not
     (vl-catch-all-error-p
       (setq item
         (vl-catch-all-apply
           (function vla-item) (list coll item)
         )
       )
     )
   )
   item
 )
)

(defun AddTable ( block pt title data / tObj tStyle )
 (setq tStyle (GetTableStyle (getvar 'CTABLESTYLE)))  
 (vlax-put-property
   (setq tObj
     (vla-AddTable block
       (vlax-3D-point pt) (1+ (length data)) (1+ (length (car data)))
       (* 1.8 (vla-getTextHeight tStyle acDataRow))
       (* 0.8
         (apply (function max)
           (mapcar (function strlen)
             (apply (function append) data)
           )
         )
          (vla-getTextHeight tStyle acDataRow)
       )
     )
   )
   'StyleName (getvar 'CTABLESTYLE)
 )
 (vla-put-RegenerateTableSuppressed tObj :vlax-true)

 (vla-SetText tObj 0 0 title)
 (setq blks
   (cond (blks)
     (
       (vla-get-blocks
         (vla-get-ActiveDocument
           (vlax-get-acad-object)
         )
       )
     )
   )
 )

 (vla-SetText tObj 1 0 "Preview")

 (
   (lambda ( row )
     (mapcar
       (function
         (lambda ( block ) (setq row (1+ row))
           (vla-SetCellType tObj row 0 acBlockCell)
           (vla-SetBlockTableRecordId tObj row 0
             (GetObjectID (Itemp blks block)) t)
         )
       )
       (mapcar (function car) (cdr data))
     )
   )
   1
 )            

 (
   (lambda ( row )
     (mapcar
       (function
         (lambda ( rowitem ) (setq row (1+ row))
           (
             (lambda ( column )
               (mapcar
                 (function
                   (lambda ( item )
                     (vla-SetText tObj row
                       (setq column (1+ column)) item
                     )
                   )
                 )
                 rowitem
               )
             )
             0
           )
         )
       )
       data
     )
   )
   0
 )
 
 (vla-put-RegenerateTableSuppressed tObj :vlax-false)
 
 tObj
)

(defun GetTableStyle ( Name )
 (if (setq Dict
       (Itemp
         (vla-get-Dictionaries
           (vla-get-ActiveDocument
             (vlax-get-acad-object)
           )
         )
         "ACAD_TABLESTYLE"
       )
     )
   (Itemp Dict Name)
 )
)

(defun GrMove ( obj prop msg cur / gr data )
 (if (vlax-property-available-p obj prop)
   (progn
     (princ msg)
     (while
       (and (= 5 (car (setq gr (grread t 13 cur))))
            (listp (setq data (cadr gr))))

       (vlax-put-property obj prop (vlax-3D-point data))
     )
     data
   )
 )
)

(defun TidyString ( str len )
 (if (> (strlen str) len)
   (strcat
     (substr str 1 (- len 3)) "..."
   )
   str
 )
)

(defun PadRight ( str char len )
 (while (< (strlen str) len)
   (setq str (strcat str char))
 )
 str
)


(defun PadLeft ( str char len )
 (while (< (strlen str) len)
   (setq str (strcat char str))
 )
 str
)

[asos2000]

As usuel

amazing man

God bless you

[Lee Mac]

You're welcome Asos

[tony bombata]

lee

 

can you include block symbols and attributes?

 

as in the routine will out put the block name, count, symbol and some selected attributes ?

 

cheers

[Lee Mac]

I'm not sure what you mean by 'symbol' (perhaps its my ignorance with AutoCAD), but as for attributes - there could be many, or none, so I'm not sure how to incoporate all the varied columns/rows...

[Patrick_35]

Hi

 

If you want count a block with or not attribute and it work with "AcDbMInsertBlock"

 

@+

Lstatt.lsp

[manddarran]

Now if there were some way to combine these two lisp routines and include the layers I would be set :-).

 

Nice work both of you, but this is beyond my skill set.