;Count selected objects length by layer and put it in table form into a drawing
;Stefan M. 22.09.2016
(defun C:LAY ( / *error* acdoc ss p i e a d l s h dz) (vl-load-com)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
dz (getvar 'dimzin))
(vla-startundomark acdoc)
(setvar 'dimzin 1)

(defun *error* (msg)
(and
msg
(not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))
(princ (strcat "\nError: " msg))
)
(setvar 'dimzin dz)
(if
(= 8 (logand (getvar 'undoctl) 8))
(vla-endundomark acdoc)
)
(princ)
)

(if
(and
(setq ss (ssget ":L" '((0 . "LINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE,HATCH"))))
(setq p (getpoint "\nTable scale depend on annotation scale.\nSpecify table insert point: "))
)
(progn
(repeat
(setq i (sslength ss))
(setq e (vlax-ename->vla-object (ssname ss (setq i (1- i))))
a (vla-get-layer e)
)
(if
(setq h (eq (vla-get-objectname e) "AcDbHatch"))
(setq s (vla-get-area e))
(setq d (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
)
(if
(setq o (assoc a l))
(if h
(setq l (subst (list a (cadr o) (+ (caddr o) s)) o l))
(setq l (subst (list a (+ (cadr o) d) (caddr o)) o l))
)
(if h
(setq l (cons (list a 0.0 s) l))
(setq l (cons (list a d 0.0) l))
)
)
)
(setq l (vl-sort l '(lambda (a b) (< (car a) (car b)))))
(insert_table l p)
)
)
(*error* nil)
(princ)
)

(defun insert_table (lst pct / tab row col ht i n space )
(setq space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
ht (/ 2.5 (cond ((getvar 'cannoscalevalue)) (1.0)))
pct (trans pct 1 0)
n (trans '(1 0 0) 1 0 T)
tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 2 (length lst)) (length (car lst)) (* 2.5 ht) ht))
)
(vlax-put tab 'direction n)

(mapcar
(function
(lambda (rowType)
(vla-SetTextStyle tab rowType (getvar 'textstyle))
(vla-SetTextHeight tab rowType ht)
)
)
'(2 4 1)
)

(vla-put-HorzCellMargin tab (* 0.14 ht))
(vla-put-VertCellMargin tab (* 0.14 ht))

(setq lst (cons '("Layer" "Length") lst))

(setq i 0)
(foreach col (apply 'mapcar (cons 'list lst))
(vla-SetColumnWidth tab i
(apply
'max
(mapcar
'(lambda (x)
((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht)))
(textbox
(list
(cons 1
(cond
((eq (type x) 'STR) x)
((eq (type x) 'INT) (itoa x))
((eq (type x) 'REAL) (rtos x))
)
)
(cons 7 (getvar 'textstyle))
(cons 40 ht))
)
)
)
col
)
)
)
(setq i (1+ i))
)

(setq lst (cons '("TITLE") lst))

(setq row 0)
(foreach r lst
(setq col 0)
(foreach c r
(if
(not (eq c 0))
(progn
(vla-SetText tab row col c)
(vla-SetCellDataType
tab row col
(cdr (assoc (type c) '((STR . 4) (REAL . 2) (INT . 1))))
acUnitless
)
(vla-setCellAlignment tab row col acMiddleCenter)
)
)
(setq col (1+ col))
)
(vla-SetRowHeight tab row (* 1.6 ht))
(setq row (1+ row))
)
)
(c:lay)

Advertisements