;;; (c) 2012 Ediciones ARTUAL, S.L. Barcelona, España.
;;; Copyright © 2012-2020 by Reinaldo N. Togores. All rights reserved.
;;; Use of this code is allowed mentioning the book and its author.
;;;Chapter 24. Tables.
(defun ins-table (/ pt row-height col-width nrows ncols)
(setq pt (getpoint "\nTable upper left corner: ")
row-height (getdist pt "\nRow height: ")
col-width (getdist pt "\nColumn width: ")
nrows (getint "\nNumber of rows: ")
ncols (getint "\nNumber of columns: "))
(vla-AddTable
(current-space *aevl:drawing*)
(vlax-3d-point pt)
nrows
ncols
row-height
col-width))
;;;Listing 24.1. Function that inserts a table in the drawing.
(defun set-row-text-height (table-obj i-row text-height /)
(setq i 0)
(repeat (vla-get-Columns table-obj)
(vla-setTextHeight2 table-obj i-row i 0 text-height)
(setq i (1+ i))))
;;;Listing 24.2. Function that changes a row's text height.
(defun set-column-text-height (table-obj i-col text-height /)
(setq i 0)
(repeat (vla-get-Rows table-obj)
(vla-setTextHeight2 table-obj i i-col 0 text-height)
(setq i (1+ i))))
;;;Listing 24.3. Function that changes a column's text height.
(defun sel-block (name / ss count ename data data-list)
(setq count 0)
(if
(setq ss (ssget "X"
(list (cons 0 "INSERT") (cons 2 name))))
(while (setq ename (ssname ss count))
(setq obj (vlax-ename->vla-object ename))
(setq data (list
(cons "LAYER" (vla-get-layer obj))
(cons "COORDS"
(vlax-safearray->list
(vlax-variant-value
(vla-get-insertionpoint obj))))))
(setq data-list (cons
(append data
(ax-read-attributes ename))
data-list))
(setq count (1+ count))))
data-list)
;;;Listing 24.4. Selection of the block to process and extraction of its attributes as a list.
(defun col-w (data-list ncols / lst-w ls)
(setq lst-w (mapcar
'(lambda (row)
(mapcar
'(lambda (cel)
(apply
'max
(list
(strlen
(vl-princ-to-string (car cel)))
(strlen
(vl-princ-to-string (cdr cel))))))
row))
data-list)
i 0)
(repeat ncols
(setq ls (cons
(apply 'max
(mapcar '(lambda (x) (nth i x)) lst-w))
ls))
(setq i (1+ i)))
(reverse ls))
;;;Listing 24.5. Function that calculates the approximate relative widths for columns.
(defun C:ATTRIB-TABLE (/ *error* curr-layout block name char-per-cols width-per-char
data-list nrows ncols pt-ins pt-corner row-height col-width
table-obj i j txt)
(vla-StartUndoMark *aevl:drawing*)
(defun *error* (msg)
(vla-EndUndoMark *aevl:drawing*)
(command-s "_U")
(prompt msg))
(if (/= (setq curr-layout (getvar "CTAB")) "Model")
(setvar "TILEMODE" 1))
(while
(not
(and (setq block (ssget "_:S" '((0 . "INSERT"))))
(equal
(vla-get-HasAttributes
(vlax-ename->vla-object (ssname block 0)))
:vlax-true)))
(prompt "\nSelect a block with attributes: "))
(setq name (cdr (assoc 2 (entget (ssname block 0))))
data-list (sel-block name)
nrows (length data-list)
ncols (length (car data-list)))
(setvar "CTAB" curr-layout)
(initget 1)
(setq pt-ins (getpoint "\nSpecify table insertion point: "))
(initget (+ 1 32))
(setq pt-corner (getcorner pt-ins "\nSpecify table size: ")
row-height (/
(abs (- (nth 1 pt-ins) (nth 1 pt-corner)))
(1+ nrows))
table-width (abs (- (nth 0 pt-corner) (nth 0 pt-ins)))
table-obj ; Table creation
(vla-AddTable
(current-space *aevl:drawing*)
(vlax-3d-point pt-ins)
(1+ nrows)
ncols
row-height
(/ table-width ncols)))
(vla-put-RegenerateTableSuppressed
table-obj
:vlax-true)
;;The column widths are adjusted to the cell text contents
(setq char-per-cols (col-w data-list ncols)
width-per-char (/
table-width
(apply '+ char-per-cols))
i 0)
(foreach w char-per-cols
(vla-SetColumnWidth table-obj i (* width-per-char w))
(setq i (1+ i)))
(vla-SetText table-obj 0 0 name) ; Title
(setq i 0)
(foreach datum (car data-list)
(vla-SetText table-obj 1 i (car datum)) ; Header
(setq i (1+ i)))
(setq i 0)
(repeat (1- nrows) ; Data rows
(setq j 0)
(repeat ncols
(vla-SetCellAlignment
table-obj
(+ i 2)
j
acMiddleCenter)
(setq txt (vl-princ-to-string
(cdr (nth j (nth i data-list)))))
(vla-SetText table-obj (+ i 2) j txt)
(setq j (1+ j)))
(setq i (1+ i)))
(vla-put-RegenerateTableSuppressed
table-obj
:vlax-false)
(vla-EndUndoMark *aevl:drawing*))
;;;Listing 24.5. Main function C:ATTRIB-TABLE.
No comments:
Post a Comment