(defun C:MT (/ col cols1 cols2 lastrow response rows1
rows2 ss start tblobj1 tblobj2 x)
(vl-load-com)
(princ "\n*** Select First table ***")
(if (setq ss (ssget "_:S:E:L" '((0 . "ACAD_TABLE"))))
(setq tblobj1 (vlax-ename->vla-object (ssname ss 0)))
)
(if (and
tblobj1
(princ "\n*** Select other tables ***")
(setq ss nil ss (ssget "_:L" '((0 . "ACAD_TABLE"))))
(or (ssdel (vlax-vla-object->ename tblobj1) ss) t)
(> (sslength ss) 0)
)
(progn
(foreach tblobj2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq
rows1 (vla-get-rows tblobj1)
tblobj2 (vlax-ename->vla-object tblobj2)
rows2 (vla-get-rows tblobj2)
lastrow rows2
cols1 (vla-get-columns tblobj1)
cols2 (vla-get-columns tblobj2)
)
(if (not (equal cols1 cols2))
(progn
(alert "There is not equivalent number of rows found. Error...")
(exit)
(princ)
)
)
(if (eq :vlax-false (vla-get-titlesuppressed tblobj2))
(progn
(setq lastrow (1- lastrow))
(setq start 1))
(setq start 0))
(if (eq :vlax-false (vla-get-headersuppressed tblobj2))
(progn
(setq lastrow (1- lastrow))
(setq start 2))
(setq start 0))
(vla-put-RegenerateTableSuppressed tblobj1 :vlax-false)
(vla-insertrows
tblobj1
rows1
(vla-getrowheight tblobj1 (1- rows1))
lastrow)

(repeat lastrow
(setq col 0)
(repeat cols1
(cond
((eq (vla-GetCellType tblobj2 start col) acBlockCell)
(vla-SetCellType tblobj1 rows1 col acBlockCell)
(vla-setcellalignment tblobj1 rows1 col (vla-getcellalignment tblobj2 start col))
(vla-setblockscale tblobj1 rows1 col (vla-getblockscale tblobj2 start col))
(if
(and
(wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
(vlax-method-applicable-p tblobj1 'getblocktablerecordid32)
)
(vla-setblocktablerecordid32
tblobj1
rows1
col
(vla-getblocktablerecordid32 tblobj2 start col)
:vlax-false
)
(vla-setblocktablerecordid
tblobj1
rows1
col
(vla-getblocktablerecordid tblobj2 start col)
:vlax-false
)
)
)
((eq (vla-GetCellType tblobj2 start col) acTextCell)
(vla-setcellalignment tblobj1 rows1 col (vla-getcellalignment tblobj2 start col))
(vla-SetCellTextHeight tblobj1 rows1 col (vla-GetCellTextHeight tblobj2 start col))
(vla-SetCellTextStyle tblobj1 rows1 col (vla-GetCellTextStyle tblobj2 start col))
(vla-settext
tblobj1
rows1
col
(vla-gettext tblobj2 start col))
)
(t nil)
)
(setq col (1+ col)))
(setq start (1+ start))
(setq rows1 (1+ rows1)))
(vla-put-RegenerateTableSuppressed tblobj1 :vlax-true)
)
(initget 1 "Yes No")
(setq response (getkword
"\nAre you want to delete the tables [Yes/No] : "))
(if (eq "Yes" response)
(mapcar 'vla-delete (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
)
;;; (mapcar (function (lambda (x)
;;; (vl-catch-all-apply
;;; (function (lambda ()
;;; (vlax-release-object x))))))
;;; (list tblobj2 tblobj1)
;;; )
)
(alert
"nothing selected or selected less than 2 tables. Error...")
)
(princ)
)
(princ "\n >> Start command with MT to merge tables")
(princ)
(c:mt)

Advertisements