Block Count without Data extraction

April 21, 2010

LEE

As expected, very good routine.

could a Block Preview be added next to each block?

April 21, 2010

asos2000 said:
LEE As expected, very good routine.

Thanks Asos

asos2000 said:
could a Block Preview be added next to each block?

With difficulty

April 21, 2010

Lee Mac said:
Thanks Asos
With difficulty

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

April 21, 2010

stevsmith said:
An I thought you liked a challenge mate.

That I do - but not this time

April 21, 2010

dbroada said:
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).

April 21, 2010

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

April 21, 2010

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

April 21, 2010

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

April 22, 2010

Lee Mac said:
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.

WtaDude0822 said:
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.

asos2000 said:
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:

April 22, 2010

asos2000 said:
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:

April 22, 2010

stevsmith said:
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

April 22, 2010

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
)

April 25, 2010

Lee

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

April 25, 2010

asos2000 said:
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
)

April 25, 2010

As usuel

amazing man

God bless you

April 26, 2010

You're welcome Asos

April 27, 2010

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

April 27, 2010

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...

April 27, 2010

Hi

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

@+

Lstatt.lspFetching info...

May 20, 2010

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.

Sign In

Block Count without Data extraction

Recommended Posts

asos2000

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Lee Mac

stevsmith

Lee Mac

alanjt

Lee Mac

WtaDude0822

asos2000

alanjt

stevsmith

Lee Mac

Lee Mac

asos2000

Lee Mac

asos2000

Lee Mac

tony bombata

Lee Mac

Patrick_35

manddarran

Join the conversation

Tutorials

Forums

Activity