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)
;;; 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)))
)
)
)