Try this routine but I'm not sure if it will be work for your Acad release
Mine is A2009, this lisp is working good in there
Code:
(defun C:Bomt(/ acsp adoc atable attdata attitem atts blkdata blkname blkobj col datalist
en headers pt row sset tabledata tags total txtheight x)
;local defun
(defun sum-and-groupby-all (lst / groups res sum tmp)
(while lst
(setq tmp (car lst)
sum
(apply '+
(mapcar 'car
(setq res (vl-remove-if-not
'(lambda (a) (vl-every 'eq a tmp))
lst
)
)
)
)
groups (cons (subst (itoa sum) (car tmp) tmp) groups)
lst
(vl-remove-if
'(lambda (a) (member a res))
lst
)
)
)
(reverse groups)
)
;main part
(if (setq sset (ssget (list (cons 0 "INSERT") (cons 66 1))))
(progn
(setq tabledata nil
attdata nil
attitem nil
)
(setq headers (list "Count" "Name" "SCH" "PLEN" "INHEI" "AFHAK" "SLEN" "PWAP" "DRAAGF" "TREKF")
tags (cddr headers)
)
(while (setq en (ssname sset 0))
(setq blkobj (vlax-ename->vla-object en)
blkname (vla-get-effectivename blkobj)
)
(setq atts (vlax-invoke blkobj 'getattributes))
(foreach attobj atts
(if (member (vla-get-tagstring attobj) tags)
(progn
(setq attitem (cons (vla-get-tagstring attobj) (vla-get-textstring attobj)))
(setq attdata (cons attitem attdata))
)
)
)
(setq blkdata (append (list 1 blkname) (reverse attdata)))
(setq tabledata (cons blkdata tabledata))
(setq attdata nil
attitem nil
)
(ssdel en sset)
)
(setq tabledata (mapcar '(lambda (x)
(append (list (car x) (cadr x))
(mapcar 'cdr (cddr x))
)
)
tabledata
)
)
(setq tabledata (sum-and-groupby-all tabledata))
;; sort by "SCH" :
(setq tabledata (vl-sort tabledata '(lambda (a b) (< (caddr a) (caddr b)))))
(setq total 0)
(foreach i datalist (setq total (+ total (cdr i))))
(or (not (zerop
(setq txtheight
(getvar "textsize")
)
)
)
(setq txtheight 54.0)
) ;<-- text height as for as in your drawing
(or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
(or acsp (setq acsp (vla-get-block (vla-get-activelayout adoc))))
(setq pt (getpoint "\nSpecify table location:"))
(setq atable (vla-addtable
acsp
(vlax-3d-point pt)
(+ 2 (length tabledata))
(length headers)
(* txtheight 2)
(* txtheight 8)
)
)
(vla-put-regeneratetablesuppressed atable :vlax-true)
(vla-put-horzcellmargin atable (* txtheight 0.5))
(vla-put-vertcellmargin atable (* txtheight 0.3))
(vla-setTextheight atable 1 txtheight)
(vla-setTextheight atable 2 txtheight)
(vla-setTextheight atable 4 txtheight)
(vla-setText atable 0 0 "Bom")
(vla-SetCellAlignment atable 0 0 acMiddleCenter)
(setq col -1)
(foreach descr headers
(vla-setText atable 1 (setq col (1+ col)) descr)
(vla-SetCellAlignment atable 1 col acMiddleCenter)
)
(setq row 2)
(foreach record tabledata
(setq col 0)
(foreach item record
(vla-setText atable row col item)
(vla-SetCellAlignment atable row col acMiddleLeft)
(setq col (1+ col))
)
(setq row (1+ row))
)
(vla-put-regeneratetablesuppressed atable :vlax-false)
)
)
(princ)
)
(prompt "\n Styart command with BOMT...\n")
(prin1)
(or (vl-load-com))
(princ)
~'J'~