Basically the block has a number of attributes defined for eg. Model, Manufacturer, Cost, Tel, Fax
It'll be good if the utility prompts to select the block, then pop-up a dialogue for us to check (select the attributes) we want to extract, next it prompts to select the blocks and summarises the total with header (eg. Model, Cost if this is the only 2 attributes selected) in atable inserted in the drawing.
The utility (A2T) below has the structure but would you be able to prompt to select the attributes to extract and use the attribute names as headers in the table?
May I ask if someone (Daniel) can help to code a BOM Utility to extract selective attributes from blocks and tabulate the summarised attribute information in a table format inserted into the drawing?
This one seems to be working for me, give that a try
(defun C:A2T (/ acsp adoc alist at atable atlist blklist bname cnt col columns data elist en ent headers item obj_list row rows ss tag)
(setq atlist (nentsel "\nSelect attribute you need:"))
(setq at (car atlist)
alist (entget at)
tag (cdr (assoc 2 alist))
blklist (cdr (assoc 330 alist))
bname (cdr (assoc 2 (entget blklist)))
)
(alert "Select blocks to summ attribute values")
(setq ss (ssget (list (cons 0 "INSERT") (cons 2 bname))))
(while (setq en (ssname ss 0))
(setq elist (entget en))
(while (/= "SEQEND" (setq ent (cdr (assoc 0 elist))))
(if
(and
(eq "ATTRIB" ent)
(eq tag (cdr (assoc 2 elist)))
)
(setq data (cons (cons (cdr (assoc 2 elist)) (cdr (assoc 1 elist)))
data))
)
(setq elist (entget (entnext (cdr (assoc -1 elist)))))
)
(ssdel en ss)
)
(setq data (append data
(list
(cons "Summ:" (apply '+ (mapcar 'atof (mapcar 'cdr data)))))))
(setq data (append (list (cons "Tag" "Value")) data))
(print data)
(if data
(progn
(vl-load-com)
(or adoc
(setq adoc (vla-get-activedocument
(vlax-get-acad-object))))
(or acsp (setq acsp (if (= (getvar "TILEMODE") 0)
(vla-get-paperspace
adoc)
(vla-get-modelspace
adoc))
)
)
(setq columns 2
rows (length data)
)
(setq atable (vla-addtable
acsp
(vlax-3d-point (getpoint "\nUpper left table insertion point: \n"))
(+ 2 rows)
columns
;; rows height (change by suit):
(* (getvar "dimtxt") 1.667)
;; columns width (change by suit):
(* (getvar "dimtxt") 8.333)
)
)
(vla-put-regeneratetablesuppressed atable :vlax-true)
(vla-settext atable 0 0 "TITLE") ;(change by suit)
(setq headers '("1" "2");(change by suit)
)
(setq col 0
row 1
)
(foreach a headers
(vla-settext atable row col a)
(setq col (1+ col))
)
(setq cnt 1 ;counter
row 2)
(repeat rows
(setq col 0
item (car data)
)
(vla-settext
atable
row
col
(car item)
)
(setq col (1+ col))
(vla-settext
atable
row
col
(cdr item)
)
(setq row (1+ row)
col 0
cnt (1+ cnt)
data (cdr data)
)
)
(vla-put-regeneratetablesuppressed atable :vlax-false)
(vlax-release-object atable)
)
)
(princ)
)
(prompt
"\n\t\t\t |-----------------------------|\n"
)
(prompt
"\n\t\t\t <| Start with A2T to execute |>\n"
)
(prompt
"\n\t\t\t |-----------------------------|\n"
)
(princ)