Message 1 of 52
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello
I have found the following code.
(defun C:COUNTATT(/ 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)
)
; 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 (mapcar '(lambda (x)
(mapcar 'cdr x)
)
tabledata
)
)
;; sort by "A1" :
(setq tabledata (vl-sort tabledata '(lambda(a b)(< (car a)(car b)))))
(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 "ATTRIBUTE 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 COUNTATT\t---\n")
(prin1)
(or (vl-load-com))
(princ)
It works great, but i need it a Little different.
Is it possible to include Mleader with block and attributes?
And it would be great if it takes (from the atached blocks) the Attribute Position as type and Count the other two attributes. I mean like:
Pos.12 : 23x 83cm / 25x 125cm
Thank you in advance...
Solved! Go to Solution.
.