Hello all!
I have a code that will gather sheet numbers and titles and update a sheet index for me based on the gathered information. However I'm being tasked to add "line-headers" when the command is run to further break the sheet index into groups based on the sheet numbers (see attached photos). The first photo is what the original code will produce, while the second photo is the result that is being asked. Is it possible to merge cells in an AutoCAD table using lisp?
In simple terms, I'm looking for a function that will merge cells in a selected table object without having to click the cells themselves and that will maintain the same number of cell rows / columns.
Sheet numbers are separated as follows:
G-0* (no header)
C-0* or C-1* = "ARCHITECTURAL PLANS"
C-2* = "STRUCTURAL PLANS"
C-4* = "SCHEDULES"
C-5* or R-6* = "DETAILS"
E-5* = "ELECTRICAL"
Hopefully this all makes sense, any help is greatly appreciated!
(defun c:SIA ( / mytable)
(setq tableSS (ssget "x" (list (cons 0 "ACAD_TABLE") (cons 410 "G-001") (cons 1 "SHEET INDEX"))))
(if tabless
(progn
(setq mytable (cadar (ssnamex tabless)))
(setq myTable (vlax-ename->vla-object myTable))
(cTb myTable 2)
(tableSheetNo mytable 2)
(tableDescription mytable 2)
(tableAllRev mytable 2))
(princ "\nNo Table Selected! Please Try Again."))
(princ)
)
(defun tablestyle (row / )
(vla-setrowheight (vlax-ename->vla-object (car (entsel))) row 1)
)
(defun cTb (table startColumn / table county row)
(setq row 0)
(setq county startColumn)
(repeat (vla-get-columns table)
(while (< county (vla-get-rows table))
(vla-settext table county row "")
(setq county (+ 1 county))
)
(setq county startColumn
row (+ row 1))
)
)
(defun tableSheetNo (table startColumn / county lLLength)
(setq county startColumn)
(if (> (setq lLLength (length (get-layout-list))) (- (vla-get-rows table) 2))
(vla-put-rows table (+ 2 lLLength)))
(foreach x (get-layout-list)
(vla-settext table county 0 x)
(setq county (+ 1 county)))
)
(defun tableDescription (table startColumn / county)
(setq county startColumn)
(foreach x (get-sheet-title)
(vla-settext table county 1 (Unformat x))
(setq county (+ 1 county)))
)
(defun tableAllRev (table startColumn / county)
(setq county 2)
(foreach x (get-rev-info)
(vla-settext table county 2 (vla-get-textstring (car x)))
(vla-settext table county 4 (vla-get-textstring (cadr x)))
(vla-settext table county 3 (vla-get-textstring (caddr x)))
(setq county (+ 1 county)))
)
(defun get-sheet-title ( / )
(vl-load-com)
(mapcar
'(lambda (y)
(apply 'vla-get-textstring (vl-remove-if-not '(lambda (x) (eq "SHEET_TITLE" (strcase (vla-get-tagstring x))))
(vlax-safearray->list (vlax-variant-value (vla-getattributes y))))))
(mapcar '(lambda (z) (vlax-ename->vla-object (car (mapcar 'cadr (ssnamex (ssget "_x" (list '(2 . "*TITLE BLOCK") (cons 410 z))))))))
(mapcar '(lambda (x) (vl-string-subst "*" "\#" x)) (get-layout-list))
)
))
(defun get-rev-info ( / listy finallist)
(vl-load-com)
(mapcar
'(lambda (y)
(setq lastRev (find-latest-rev y))
(vl-remove-if-not '(lambda (x) (or (eq (strcat "REV_BY_" lastrev) (strcase (vla-get-tagstring x)))(eq (strcat "REV_DATE_" lastrev) (strcase (vla-get-tagstring x)))(eq (strcat "REV_NUMBER_" lastrev) (strcase (vla-get-tagstring x))))) (vlax-safearray->list (vlax-variant-value (vla-getattributes y))))
)
(setq listy (mapcar '(lambda (z) (vlax-ename->vla-object (car (mapcar 'cadr (ssnamex (ssget "_x" (list '(2 . "*TITLE BLOCK") (cons 410 z)))))))) (get-layout-list)))
)
)
(defun find-latest-rev (vlaEnt / )
(substr
(setq revName
(caar
(vl-sort
(vl-remove nil
(mapcar
'(lambda (x)
(if ;t
(wcmatch (strcase (vla-get-tagstring x)) "REV_NUMBER_*")
(cons (vla-get-tagstring x) (vla-get-textstring x))))
;(setq revList (append revList (list (vla-get-textstring x))))))
(vlax-safearray->list (vlax-variant-value (vla-getattributes vlaEnt)))))
'(lambda (x1 x2) (> (ascii (cdr x1)) (ascii (cdr x2)))))))
(strlen revName)
)
)
(defun get-layout-list( / listy);
(vlax-for var (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
(setq listy (cons (cons (vla-get-TabOrder var) (vla-get-Name var)) listy)))
(cdr (mapcar 'cdr (vl-sort listy '(lambda (x y) (< (car x) (car y)))))))
(defun Unformat ( str / _replace rx )
(defun _replace ( new old str )
(vlax-put-property rx 'pattern old)
(vlax-invoke rx 'replace str new)
)
(if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
(progn
(setq str
(vl-catch-all-apply
(function
(lambda ( )
(vlax-put-property rx 'global actrue)
(vlax-put-property rx 'multiline actrue)
(vlax-put-property rx 'ignorecase acfalse)
(foreach pair
'(
(" " . "\\\\P|\\n|\\t")
)
(setq str (_replace (car pair) (cdr pair) str))
)
)
)
)
)
(vlax-release-object rx)
(if (null (vl-catch-all-error-p str))
str
)
)
)
)
