I think I see what you're after...
(defun c:test ( / i rtn ss tags)
(setq tags ; these are the tags. They will appear left to right sorted in the order below
'(
"DESC-S"
"PTNO-S"
"QTY-S"
)
)
(if (setq ss (ssget '((0 . "INSERT"))))
(progn
(repeat (setq i (sslength ss))
(setq rtn
(cons
(mapcar 'cdr
(vl-sort
(vl-remove nil
(mapcar
'(lambda (x / ps)
(if (setq ps (vl-position (vla-get-TagString x) tags))
(cons ps (vla-get-TextString x))
)
)
((lambda (x) (append (vlax-invoke x 'GetConstantAttributes) (vlax-invoke x 'GetAttributes)))
(vlax-ename->vla-object (ssname ss (setq i (1- i))))
)
)
)
'(lambda (a b) (< (car a) (car b)))
)
)
rtn
)
)
)
(JH:list-to-table (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
(append '(("Data Extraction")) (list tags) (vl-remove nil rtn))
(getpoint "\nSpecify insertion point for table: ")
(getvar 'ctablestyle)
)
)
)
)
;; JH:list-to-table --> Jonathan Handojo
;; Creates a table from a list of lists of strings
;; space - ModelSpace or Paperspace vla object
;; lst - list of lists where each list is a list of strings
;; => if you wish to insert a block in the cell, prefix using "<block>" followed by the block name
;; => e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1"
;; pt - Insertion point of table (2 or 3 reals)
;; tblstyle - Table style to use
(defun JH:list-to-table (space lst pt tblstyle / i j lens ncols rows totlen txt vtable)
(setq ncols (apply 'max (mapcar 'length lst))
vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10)
)
(vla-put-RegenerateTableSuppressed vtable :vlax-true)
(vla-put-StyleName vtable tblstyle)
(repeat (setq i (length lst))
(setq rows (nth (setq i (1- i)) lst))
(vla-SetRowHeight vtable i (* 2 (vlax-invoke vtable 'GetCellTextHeight i 0)))
(repeat (setq j (length rows))
(setq lens
(cons
(+
(abs
(apply '-
(mapcar 'car
(textbox
(list
(cons 1 (setq txt (nth (setq j (1- j)) rows)))
(cons 7 (vlax-invoke vtable 'GetCellTextStyle i j))
)
)
)
)
)
(vlax-invoke vtable 'GetCellTextHeight i j)
)
lens
)
)
(if (eq (strcase (substr txt 1 7)) "<BLOCK>")
(progn
(setq blk (substr txt 8))
(if (and
(wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
(vlax-method-applicable-p vtable 'setblocktablerecordid32)
)
(vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)))
(vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)) :vlax-true)
)
)
(vla-SetText vtable i j txt)
)
)
(setq totlen (cons lens totlen) lens nil)
)
(repeat ncols
(vla-SetColumnWidth vtable (setq ncols (1- ncols))
(apply 'max
(vl-remove nil
(mapcar
'(lambda (x)
(nth ncols x)
)
totlen
)
)
)
)
)
(vla-put-RegenerateTableSuppressed vtable :vlax-false)
vtable
)