Jump to content

Block Count without Data extraction


stevsmith

Recommended Posts

I don't know if this falls under the lisp category, but I'm sure it would end up here anyway.

 

Is there a way to count the number of blocks in a drawing without the use of data extraction. Ideally I would like to have it appear in the Q-properties window when I click on the block in question, but there doesn't seem to be this type of option in the cui for this to happen.

 

 

Ideally what I would like is, I'd to click on the block in question and information regarding how many of these blocks are in the current model space.

Kind of similar to LeeMac's DYNinfo lisp.

Link to comment
Share on other sites

  • Replies 43
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    15

  • asos2000

    11

  • stevsmith

    6

  • alanjt

    4

I was going to suggest BCount, except that you have to select each block, or select ALL blocks...

 

(defun c:Test (/ ent)
 (and (setq ent (car (entsel "\nSelect block: ")))
      (or (eq "INSERT" (cdr (assoc 0 (entget ent))))
          (alert "Invalid object!")
      )
      (alert (strcat (itoa (sslength (ssget "_X"
                                            (list '(0 . "INSERT")
                                                  (assoc 2 (entget ent))
                                                  (if (eq 2 (getvar "cvport"))
                                                    (cons 410 "Model")
                                                    (cons 410 (getvar "ctab"))
                                                  )
                                            )
                                     )
                           )
                     )
                     " occurances of block \""
                     (cdr (assoc 2 (entget ent)))
                     "\" within current layout."
             )
      )
 )
 (princ)
)

Link to comment
Share on other sites

Thanks Alan, I was kind of puzzled by the bcount to start off with.

I'll give your lisp a crack tomorrow as I've finished work now.

 

Cheers

Link to comment
Share on other sites

Kind of similar to LeeMac's DYNinfo lisp.

 

I think my LISP actually has this field when you move over a block :)

 

As an alternative, I wrote this a while back, should count nested occurrences too:

 

;; Block Counter by Lee McDonnell (Lee Mac) ~ 22.08.2009
;; Copyright © August 2009

;; Will Count all instances of a block, including nested.

(defun BlkCount (Blk / i j ss *blk)
 (vl-load-com)
 (setq i 0 Blk (strcase Blk) j -1 *blk (vla-get-Blocks
                                         (vla-get-ActiveDocument
                                           (vlax-get-acad-object))))

 (defun GetNest (Obj Nme)
   (and (eq (strcase (vla-get-Name Obj)) Nme) (setq i (1+ i)))
   (vlax-for Sub Obj
     (if (eq "AcDbBlockReference" (vla-get-ObjectName Sub))
       (GetNest (vla-item *blk (vla-get-EffectiveName Sub)) Nme))))

 (if (setq ss (ssget "_X" '((0 . "INSERT"))))
   (while (setq ent (ssname ss (setq j (1+ j))))
     (GetNest
       (vla-item *blk
         (vla-get-EffectiveName
           (vlax-ename->vla-object ent))) Blk)))
 
 i)

(defun c:test (/ str lst tdef)
 (while
   (progn
     (setq str (getstring t "\nSpecify Block Name <All> : "))
     (cond ((eq "" str)
            (while (setq tdef (tblnext "BLOCK" (null tdef)))
              (setq lst (cons (cdr (assoc 2 tdef)) lst)))
            (setq lst (vl-remove-if
                        (function
                          (lambda (x)
                            (wcmatch x "`**"))) lst)) nil)
           ((and (snvalid str)
                 (tblsearch "BLOCK" str))
            (setq lst (list str)) nil)
           (t (princ "\n** Block not Found **")))))

 (setq mstr (+ 5 (apply 'max (mapcar 'strlen lst))))             
 (princ (strcat (Pad "\n Block" 32 mstr) "| Count"))
 (princ (strcat (Pad "\n " 45 mstr) (Pad "|" 45 10)))

 (foreach x lst
   (setq i (Blkcount x))
   (princ
     (strcat
       (Pad (strcat "\n " x) 46 mstr)
       (Pad "|" 46 (- 10 (strlen (itoa i)))) (itoa i))))        

 (princ))

(defun Pad (Str Chc Len)
 (while (< (strlen Str) Len)
   (setq Str (strcat Str (chr Chc))))
 Str)

 

Needs tidying up and probably isn't the best way to approach it... :S

Link to comment
Share on other sites

Another for consideration

 

[i][color=#990099];; Block Counter (Lee Mac)[/color][/i]
[i][color=#990099];; Will produce a report of the number of[/color][/i]
[i][color=#990099];; each block in all layouts.[/color][/i]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:BNum [b][color=RED]([/color][/b] [b][color=BLUE]/[/color][/b] bLst rLen [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b]
 [i][color=#990099];; Lee Mac  ~  19.04.10[/color][/i]

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bLst
   [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] block [b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] block [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b]BlockList [b][color=#009900]125[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bLst
   [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] item [b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] item[b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]itoa[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] item[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]vlax-for[/color][/b] lay
       [b][color=RED]([/color][/b][b][color=BLUE]vla-get-layouts[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b]
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]    
       [b][color=RED]([/color][/b][b][color=BLUE]vlax-for[/color][/b] obj [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Block[/color][/b] lay[b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#a52a2a]"AcDbBlockReference"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-property[/color][/b] obj [b][color=DARKRED]'[/color][/b]ObjectName[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] a [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=RED]([/color][/b]BlockName obj[b][color=RED])[/color][/b] bLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] bLst
               [b][color=RED]([/color][/b][b][color=BLUE]subst[/color][/b]
                 [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] a[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] a[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] a bLst
               [b][color=RED])[/color][/b]
             [b][color=RED])[/color][/b]
           [b][color=RED])[/color][/b]
         [b][color=RED])[/color][/b]
         bLst
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] rLen
   [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] [b][color=#009900]3[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]apply[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]max[/color][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]5[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]strlen[/color][color=RED])[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]cdr[/color][color=RED])[/color][/b] bLst[b][color=RED])[/color][/b]
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] item [b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"\n"[/color][/b]
           [b][color=RED]([/color][/b]PadRight [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] item[b][color=RED])[/color][/b] [b][color=#a52a2a]"."[/color][/b]   [b][color=#009900]40[/color][/b][b][color=RED])[/color][/b] [b][color=#a52a2a]"|"[/color][/b]
           [b][color=RED]([/color][/b]PadLeft  [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] item[b][color=RED])[/color][/b] [b][color=#a52a2a]"."[/color][/b] rLen[b][color=RED])[/color][/b]
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b]
     [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#a52a2a]"Block Name"[/color][/b] . [b][color=#a52a2a]"Count"[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b]
         [b][color=RED]([/color][/b]PadRight [b][color=#a52a2a]""[/color][/b] [b][color=#a52a2a]"-"[/color][/b]   [b][color=#009900]40[/color][/b][b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b]PadLeft  [b][color=#a52a2a]""[/color][/b] [b][color=#a52a2a]"-"[/color][/b] rLen[b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]vl-sort[/color][/b] bLst
         [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] a b [b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] a[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] b[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED])[/color][/b]
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]
 
 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b]
[b][color=RED])[/color][/b]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] BlockName [b][color=RED]([/color][/b] obj [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-property[/color][/b] obj
   [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-property-available-p[/color][/b] obj [b][color=DARKRED]'[/color][/b]EffectiveName[b][color=RED])[/color][/b]
     [b][color=DARKRED]'[/color][/b]EffectiveName [b][color=DARKRED]'[/color][/b]Name
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]
[b][color=RED])[/color][/b]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] BlockList [b][color=RED]([/color][/b] ignore [b][color=BLUE]/[/color][/b] def lst [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] def [b][color=RED]([/color][/b][b][color=BLUE]tblnext[/color][/b] [b][color=#a52a2a]"BLOCK"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]null[/color][/b] def[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]zerop[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]boole[/color][/b] [b][color=#009900]1[/color][/b] ignore [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]70[/color][/b] def[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lst [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]2[/color][/b] def[b][color=RED])[/color][/b][b][color=RED])[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]
 lst
[b][color=RED])[/color][/b]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] TidyString [b][color=RED]([/color][/b] str len [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strlen[/color][/b] str[b][color=RED])[/color][/b] len[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]substr[/color][/b] str [b][color=#009900]1[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] len [b][color=#009900]3[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#a52a2a]"..."[/color][/b]
   [b][color=RED])[/color][/b]
   str
 [b][color=RED])[/color][/b]
[b][color=RED])[/color][/b]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] PadRight [b][color=RED]([/color][/b] str char len [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strlen[/color][/b] str[b][color=RED])[/color][/b] len[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] str [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] str char[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]
 str
[b][color=RED])[/color][/b]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] PadLeft [b][color=RED]([/color][/b] str char len [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strlen[/color][/b] str[b][color=RED])[/color][/b] len[b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] str [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] char str[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]
 str
[b][color=RED])[/color][/b]

Link to comment
Share on other sites

Give this one a try, i do not rememebr where I get.

this routine creates a table.

 

;;; ability to drag an move a vla object
;;; msg: optional message by default uses "Move"
((defun drag-move  (msg vla_obj / take code5 p3)
 (prompt (strcat "\n"
   (cond (msg)
  ("Move"))
   "\n"))
 (while (and (setq take (grread 't)) (/= 3 (car take)))
   (setq code5 (car take))
   (setq p3 (cadr take))
   (if (and p3 (= 5 code5))
     (vla-move
vla_obj
(vla-get-insertionpoint vla_obj)
(vlax-3d-point p3)))))
(defun C:BLKQTY (/      table_headers    table_rows vla_table column
   row      lst docblocks  ss       i  ename
   obj)
 (vl-load-com)
 (if (setq ss (ssget "x" (list (cons 0 "INSERT"))))
   (progn
     (setq docblocks
     (vla-get-blocks
       (vla-get-activedocument (vlax-get-acad-object))))
     (setq i 0)
     (repeat (sslength ss)
(setq ename (ssname ss i))
(setq obj (vlax-ename->vla-object ename))
(if (not (vl-position (vla-get-name obj) lst))
  (progn
    (setq lst (cons (vla-get-name obj) lst))
    (setq table_rows
    (cons (list (vla-get-name obj)
         (vla-get-count (vla-item docblocks (vla-get-name obj)))
         (vla-get-objectid (vla-item docblocks (vla-get-name obj))))
  table_rows))))
(setq i (1+ i)))
     ;; headers list
     (setq table_headers (list "Block Preview" "Block Name" "Quantity"))
     ;; object Table
     (setq
vla_table
(vla-addtable
   ;; for test place the object on model space
   (vla-get-modelspace
     (vla-get-activedocument (vlax-get-acad-object)))
   ;; base = 0,0,0
   (vlax-3d-point (list 0 0 0))
   ;; rows number - including title & headers
   (+ (length table_rows) 2)
   ;; columns number
   (length table_headers)
   ;; row height
   10.0
   ;; column width
   10.0))
     ;; set title name
     (vla-settext vla_table 0 0 "Block Quantity")
     ;; cell alignment
     (vla-setcellalignment vla_table 0 0 acmiddlecenter)
     ;; cell text height
     (vla-setcelltextheight vla_table 0 0 220)
     ;; first column
     (setq column 0)
     ;; generates all headers
     (foreach
     item
 table_headers
;; header
(vla-settext vla_table 1 column item)
;; alignment
(vla-setcellalignment vla_table 1 column acmiddlecenter)
;; text height
(vla-setcelltextheight vla_table 1 column 220)
;; next column
(setq column (1+ column)))
     ;; start with row 2
     (setq row 2)
     ;; first column
     (setq column 0)
     ;; generate all rows
     (foreach
     item
 table_rows
(vla-SetBlockTableRecordId vla_table row 0 (last item) :vlax-true)
(vla-setcellalignment vla_table row 0 acmiddlecenter)
;; cell text
(vla-settext vla_table row 1 (car item))
;; alignment
(vla-setcellalignment vla_table row 1 acmiddlecenter)
;; text height
(vla-setcelltextheight vla_table row 1 220)

;; cell text
(vla-settext vla_table row 2 (itoa (cadr item)))
;; alignment
(vla-setcellalignment vla_table row 2 acmiddlecenter)
;; text height
(vla-setcelltextheight vla_table row 2 220)
;; next row
(setq row (1+ row)))
     (drag-move nil vla_table)))
 (princ)))

Link to comment
Share on other sites

Alan, Your lisp worked great, It's exactly what I was looking for. A quick reliable counter.

Lee, your lisp will come in very handy for larger jobs that I have to deal with.

Asos, your lisps output seems corrupted. It has a good idea of a block preview in the table, but alot of the data was jumbled. i like the idea of the table in the drawing though.

Link to comment
Share on other sites

First one takes long time

and this is the result

Command: test
Specify Block Name <All> :
Block                                                                          
                         | Count
-------------------------------------------------------------------------------
--------------------------|---------
EC-standards...................................................................
..........................|........0
Xref-EC-BS-FRAME|EC-BASRAH-TITLE...............................................

 

second one gives an error

Command: BNUM
_.layer
Current layer:  "EC-SEC-ELEV"
Enter an option 
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock
/stAte]: set
Enter layer name to make current or <select object>: Enter an option 
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck/Unlock
/stAte]:
Command: ; error: An error has occurred inside the *error* functionAutoCAD 
variable setting rejected: "cmdecho" nil

Link to comment
Share on other sites

I expected the first one to take a long time - it is due to the way it is coded.

 

As for the second, I cannot understand your output, as the code does not even have an error function, and does not deal with layers.

Link to comment
Share on other sites

Alan, Your lisp worked great, It's exactly what I was looking for. A quick reliable counter.

Glad it helps. It was a quickie.

 

alanjt

- Nice idea could I use?

- Not working with DB

LEE

- good routine but takes long time.

It's all yours. :)

Link to comment
Share on other sites

Could be inserted in the table, Let me try to code it.

 

But one question

How to get the blocks number to get use in specify how many rows will be used?

Link to comment
Share on other sites

Another to play with :)

 

;; 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.
;; Also lists blocks with zero count - Purge warning?

(defun c:BNum ( / 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))
         )
       )
     )
     (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)
             )
           )
         )
       )
     )
   )
 )

 (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
       (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 )
 (vlax-put-property
   (setq tObj
     (vla-AddTable block
       (vlax-3D-point pt) (1+ (length data)) (length (car data))
       (* 1.5 (getvar 'TEXTSIZE))
       (* 1.5
         (apply (function max)
           (mapcar (function strlen)
             (apply (function append) data)
           )
         )
       )
     )
   )
   '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 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
)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...