Try it again
Code:
(defun C:PARTREF3(/ acapp acol acsp adoc atable attdata attitem atts blkdata blkname blkobj col
column colwidth datalist en headers pt row sset swap tabledata tags total txtheight widths x)
;private function
(defun sum-and-groupby-three (lst / groups res sum tmp)
(while lst
(setq tmp (car lst)
sum
(apply '+
(mapcar 'atoi (mapcar 'cdadr
(setq res (vl-remove-if-not
'(lambda (a) (and
(eq (cdr (nth 0 a)) (cdr (nth 0 tmp)))
(eq (cdr (nth 1 a)) (cdr (nth 1 tmp)))
(eq (cdr (nth 2 a)) (cdr (nth 2 tmp)))))
lst
)
)
))
)
groups (cons (subst (cons "QTY" (itoa sum))(cadr tmp) tmp) groups)
lst
(vl-remove-if
'(lambda (a) (member a res))
lst
)
)
)
(reverse groups)
)
;private function
(defun sum-and-groupby (lst / count countdata elem match tmp)
(while lst
(setq tmp (car lst))
(setq match (vl-remove-if-not '(lambda(x)(and (eq (cdr (nth 0 x))(cdr (nth 0 tmp) ))
(eq (cdr (nth 2 x))(cdr (nth 2 tmp) ))
(eq (cdr (nth 3 x))(cdr (nth 3 tmp) ))))
lst))
(setq count (apply '+ (mapcar 'atoi (mapcar 'cdr (mapcar 'cadr match)))))
(setq elem (list (cdr (nth 0 tmp))
(itoa count)
(cdr (nth 2 tmp))
(cdr (nth 3 tmp))
(cdr (nth 4 tmp))))
(setq countdata (cons elem countdata))
(setq lst (vl-remove-if '(lambda(x)(and (eq (cdr (nth 0 x))(cdr (nth 0 tmp) ))
(eq (cdr (nth 2 x))(cdr (nth 2 tmp) ))
(eq (cdr (nth 3 x))(cdr (nth 3 tmp) ))))
lst))
)
(vl-sort countdata '(lambda(a b)(< (car a)(car b))))
)
; main part ;
(if (setq sset (ssget (list (cons 0 "INSERT") (cons 66 1))))
(progn
(setq tabledata nil
attdata nil
attitem nil
)
(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
(setq attitem (cons (vla-get-tagstring attobj) (vla-get-textstring attobj)))
(setq attdata (cons attitem attdata))
)
(setq tabledata (cons (reverse attdata) tabledata))
(setq attdata nil
attitem nil
)
(ssdel en sset)
)
(setq headers (mapcar 'car (car tabledata))
tags headers
)
(setq tabledata (sum-and-groupby-three tabledata))
(setq tabledata (sum-and-groupby tabledata))
;; sort by "PART-REF" :
(setq total 0)
(foreach i datalist (setq total (+ total (cdr i))))
(initget 6)
(setq txtheight (getreal "\nSpecify Text height for the table <50>:"))
(cond ((not txtheight)(setq txtheight 50))) ;<-- text height as for as in your drawing
(or adoc (setq adoc (vla-get-activedocument (setq acapp (vlax-get-acad-object)))))
(or acsp (setq acsp (vla-get-block (vla-get-activelayout adoc))))
(setq acCol (vla-GetInterfaceObject acapp(strcat "AutoCAD.AcCmColor." (itoa(atoi(getvar "acadver"))))))
(setq pt (getpoint "\nSpecify table location:"))
(setq atable (vla-addtable
acsp
(vlax-3d-point pt)
(+ 2 (length tabledata))
(length headers)
(* txtheight 1.2)
(* txtheight 20)
)
)
(vla-put-regeneratetablesuppressed atable :vlax-true)
;; calculate column widths :
(setq swap (append (list headers) tabledata)
widths nil)
(while (car swap)
(setq column (mapcar 'car swap))
(setq colwidth (* 1.2 (apply 'max (mapcar 'strlen column))txtheight))
(setq widths (cons colwidth widths))
(setq swap (mapcar 'cdr swap)))
(setq widths (reverse widths))
;; set column widths
(setq col 0)
(foreach wid widths
(vla-setcolumnwidth atable col wid)
(setq col (1+ col))
)
(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 "PART SUMMARY")
(vla-SetCellAlignment atable 0 0 acMiddleCenter)
(vla-put-colorindex accol 2)
(vla-setcellcontentcolor atable 0 0 accol)
(setq col -1)
(foreach descr headers
(vla-setText atable 1 (setq col (1+ col)) descr)
(vla-SetCellAlignment atable 1 col acMiddleCenter)
(vla-setcellcontentcolor atable 1 col accol)
)
(vla-put-colorindex accol 4)
(setq row 2)
(foreach record tabledata
(setq col 0)
(foreach item record
(vla-setText atable row col item)
(if (= 1 col)
(vla-SetCellAlignment atable row col acMiddleCenter)
(vla-SetCellAlignment atable row col acMiddleLeft)
)
(vla-setcellcontentcolor atable row col accol)
(setq col (1+ col))
)
(setq row (1+ row))
)
(vla-put-width atable (apply '+ widths))
(vla-put-height atable (* 1.2 (vla-get-rows atable)txtheight))
(vla-put-regeneratetablesuppressed atable :vlax-false)
)
)
(if accol (vlax-release-object accol))
(if acapp (vlax-release-object acapp))
(princ)
)
(prompt "\n\t---\tStart command with PARTREF3\t---\n")
(prin1)
(or (vl-load-com))
(princ)
;;-------------------------------------------------------------------------------;;
~'J'~