Topic: Tables with Blocks

[DanB]

Looking for any advise or direction on automating the following process. I will try to spell out best case scenario and try to work out the best solution from there.

We would like to take a drawing that contains a series of block definitions (say 50-100 blocks) and create an AutoCAD Table describing these blocks.

Column 1 = block insert    Column 2 = Block Name   Column 3 = Description **   Column 4 = Scale **

Ideally Column 1 and 2 could be automated?? Again best case is it possible to link (fields?) Column 2 with Column 1? **Column 3 and 4 would be manually keyed in.

As always thanks for the help.

Dan

[CAB]

Maybe this will get you started:
http://www.theswamp.org/index.php?topic=13878.msg167603#msg167603

[DanB]

This looks promising, downloading and off to do some testing. Thanks CAB.

[gile]

Hi,

You can take some inspiration from this one.

It's a collective work from Call me Bert' (he did the most) and I (I only adapted)

Code: [Select]

;;; Tablock -Tramber (CADxp)-
;;; Creates a table with selected blocks or all collection

(defun c:tablock (/     AcDoc    Space    libloc   liidbloc
   sst     ssu      liref    ptins    tableVL
   cont
  )

  (vl-load-com)
 
  (defun Ename->Name (bl)
    (setq bl (vlax-ename->vla-object bl))
    (if (vlax-property-available-p bl 'EffectiveName)
      (vla-get-EffectiveName bl)
      (vla-get-Name bl)
    )
  )

  (setq AcDoc (vla-get-activedocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
      )
  )
  (prompt "\nSelect blocks to be listed or < All >")
  (setq ssu (ssget '((0 . "INSERT"))))
  (setq sst (ssget "_X" '((0 . "INSERT"))))
  (if sst
    (setq liref (mapcar 'Ename->Name (mapcar 'cadr (ssnamex sst))))
    (setq liref '())
  )
  (if ssu
    (setq libloc   (remove_doubles
     (mapcar 'Ename->Name
     (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssu)))
     )
   )
  liidbloc (mapcar
     '(lambda (x)
(vla-get-ObjectID
  (vla-item
    (vla-get-Blocks
      AcDoc
    )
    x
  )
)
      )
     libloc
   )
  liref    (vl-remove-if-not '(lambda (n) (member n libloc)) liref)
    )
    (vlax-for i (vla-get-Blocks AcDoc)
      (if (and (/= (substr (vla-get-name i) 1 1) "*")
       (= :vlax-false (vla-get-IsXref i))
  )
(setq libloc   (append libloc (list (vla-get-name i)))
      liidbloc (append liidbloc (list (vla-get-ObjectID i)))
)
      )
    )
  )
  (initget 1)
  (setq ptins (trans (getpoint "\nInsertion point: ") 1 0))
  (setq tableVL (vla-addtable
  (vla-get-modelspace
    (vla-get-activedocument (vlax-get-acad-object))
  )
  (vlax-3d-point ptins)
  (+ (length libloc) 2)
  3
  20
  100
)
  )
  (vla-put-TitleSuppressed tableVL :vlax-false)
  (vla-setText tableVL 0 0 "CAPTION/QUANTITATIVE")
  (mapcar '(lambda (x)
(vla-setText tableVL 1 (car x) (cdr x)))
  '((0 . "SYMBOL") (1 . "DESIGNATION") (2 . "QUANTITY"))
  )
  (setq cont 0) 
  (repeat (vla-get-Rows tableVL)
    (vla-SetBlockTableRecordId
      tableVL
      (1+ (setq cont (1+ cont)))
      0
      (nth (1- cont) liidbloc)
      :vlax-true
    )
    (vla-settext
      tableVL
      (1+ cont)
      1
      (nth (1- cont) libloc)
    )
    (vla-settext
      tableVL
      (1+ cont)
      2
      (length (vl-remove-if-not
'(lambda (n) (= n (nth (1- cont) libloc)))
liref
      )
      )
    )
    (vla-setcellalignment tableVL (1+ cont) 1 5)
    (vla-setcellalignment tableVL (1+ cont) 2 5)
  )
  (princ)
)

;;; REMOVE_DOUBLES - Removes all doubles in a list

(defun REMOVE_DOUBLES (lst)
  (cond
    ((atom lst) lst)
    (T
     (cons (car lst) (REMOVE_DOUBLES (vl-remove (car lst) lst)))
    )
  )
)


[DanB]

Thank You, this too looks useful and possibly a little more manageable for what we need.

[T.Willey]

This seemed like fun, so I came up with this one while on a break.  Will create a table that will show the block in the first column the block name in the second and the count in the third.

Have fun. 

Code: [Select]

(defun c:TableBlockLegend (/ ActDoc ss Ent BlkName tempList EndList TblObj Rowcnt)

(defun GetCurrentSpace (Doc / BlkCol SpaceList CurSpace ActSpace temp1)
; Returns the "block object" for the active space
; Thanks to Jeff Mishler

(if (= (getvar "cvport") 1)
 (vla-get-PaperSpace Doc)
 (vla-get-ModelSpace Doc)
)
)
;-----------------------------------------------------------------------------------
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (setq ss (ssget "x" '((0 . "INSERT") (410 . "Model"))))
 (while (setq Ent (ssname ss 0))
  (setq BlkName (cdr (assoc 2 (entget Ent))))
  (if (setq tempList (assoc BlkName EndList))
   (setq EndList (subst (cons BlkName (1+ (cdr tempList))) tempList EndList))
   (setq EndList (cons (cons BlkName 1) EndList))
  )
  (ssdel Ent ss)
 )
)
(if (and EndList (setq Pt (getpoint "\n Select insertion point of table: ")))
 (progn
  (setq TblObj (vlax-invoke (GetCurrentSpace ActDoc) 'AddTable Pt (+ 2 (length EndList)) 3 (/ 3 16.0) 2.0))
  (vla-put-RegenerateTableSuppressed TblObj :vlax-true)
  (vla-put-TitleSuppressed TblObj :vlax-false)
  (vla-put-HeaderSuppressed TblObj :vlax-false)
  (vla-SetText TblObj 0 0 "Legend")
  (vla-SetText TblObj 1 0 "Block")
  (vla-SetText TblObj 1 1 "Block Name")
  (vla-SetText TblObj 1 2 "Block Count")
  (setq Rowcnt 2)
  (setq BlkCol (vla-get-Blocks ActDoc))
  (foreach Lst (vl-sort EndList '(lambda (a b) (< (strcase (car a)) (strcase (car b)))))
   (vla-SetCellType TblObj Rowcnt 0 acBlockCell)
   (vla-SetBlockTableRecordId TblObj Rowcnt 0 (vla-get-ObjectId (vla-Item BlkCol (car Lst))) T)
   (vla-SetCellType TblObj Rowcnt 1 acTextCell)
   (vla-SetText TblObj Rowcnt 1 (car Lst))
   (vla-SetCellType TblObj Rowcnt 2 acTextCell)
   (vla-SetText TblObj Rowcnt 2 (itoa (cdr Lst)))
   (setq Rowcnt (1+ RowCnt))
  )
  (vla-put-RegenerateTableSuppressed TblObj :vlax-false)
  (vla-Update TblObj)
 )
)
(princ)
)


[DanB]

I haven't yet pieced together the routine but glad this has generated some interest. Tables have been a very nice addition.

[T.Willey]

Mine is a complete routine.  You run it, and it will generate the table for you.

[gile]

Mine too, it just prompt you to select which blocks do tou want to list (or all collection).