Was bored, and this seemed like a challenge, so here is what I came up with to copy part of a table to a new table. The object selected has to be a table table.
It will copy the title, if any, always. If you select in the header row, then it will copy the header as a header type, else if will copy the data as a data type. Only works on text tables.
(defun c:CopyPartOfTable (/ Pt ss EndPt VwDir cnt Ent Obj sRow sCol eRow eCol RowColList InsPt maxRow Title Header TblObj
cntRow cntCol tempCntCol oOsMode)
(if
(and
(setq oOsMode (getvar 'OsMode))
(setvar 'OsMode 0)
(setq Pt (getpoint "\n Select first point of window (not in title row): "))
(setq ss
(ssget
"_C"
(getvar 'VsMin)
(getvar 'VsMax)
'((0 . "ACAD_TABLE"))
)
)
(setq EndPt (getcorner Pt "\n Select second point of window (not in title row): "))
(setq VwDir (getvar 'ViewDir))
(setq cnt -1)
(progn
(while (setq Ent (ssname ss (setq cnt (1+ cnt))))
(setq Obj (vlax-ename->vla-object Ent))
(if
(and
(equal (vla-HitTest Obj (vlax-3d-point Pt) (vlax-3d-point VwDir) 'sRow 'sCol) :vlax-true)
(equal (vla-HitTest Obj (vlax-3d-point EndPt) (vlax-3d-point VwDir) 'eRow 'eCol) :vlax-true)
sRow sCol eRow eCol
(not RowColList)
)
(setq RowColList (list Obj sRow sCol eRow eCol))
)
)
(equal (length RowColList) 5)
)
(setq InsPt (getpoint "\n Insertion point for new table: "))
)
(progn
(setq MaxRow (1+ (abs (- (nth 1 RowColList) (nth 3 RowColList)))))
(setq sRow 1)
(if (equal (vla-get-TitleSuppressed (car RowColList)) :vlax-true)
(progn
(setq Title :vlax-true)
(setq sRow (1- sRow))
)
(progn
(setq Title :vlax-false)
(setq MaxRow (1+ MaxRow))
)
)
(setq TblObj
(vlax-invoke
(vlax-get
(vla-get-ActiveDocument (vlax-get-Acad-Object))
(if (equal (getvar 'CVport) 1)
'PaperSpace
'ModelSpace
)
)
'AddTable
InsPt
MaxRow
(1+ (abs (- (nth 2 RowColList) (nth 4 RowColList))))
(vla-GetRowHeight (car RowColList) (cadr RowColList))
(vla-GetColumnWidth (car RowColList) (caddr RowColList))
)
)
(vla-put-RegenerateTableSuppressed TblObj :vlax-true)
(vla-put-TitleSuppressed TblObj Title)
(if (equal Title :vlax-false)
(progn
(vla-SetText TblObj 0 0 (vla-GetText (car RowColList) 0 0))
(vla-SetCellTextHeight TblObj 0 0 (vla-GetCellTextHeight (car RowColList) 0 0))
(vla-SetCellAlignment TblObj 0 0 (vla-GetCellAlignment (car RowColList) 0 0))
)
)
(setq eRow
(if (< (cadr RowColList) (cadddr RowColList))
(cadr RowColList)
(cadddr RowColList)
)
)
(if
(and
(equal (vla-get-HeaderSuppressed (car RowColList)) :vlax-flase)
(equal eRow 1)
)
(vla-put-HeaderSuppressed TblObj :vlax-false)
)
(setq cntRow (1+ (abs (- (cadr RowColList) (cadddr RowColList)))))
(setq eCol
(if (< (caddr RowColList) (last RowColList))
(caddr RowColList)
(last RowColList)
)
)
(setq cntCol (1+ (abs (- (caddr RowColList) (last RowColList)))))
(repeat cntRow
(setq cnt 0)
(setq tempCntCol eCol)
(repeat cntCol
(vla-SetText TblObj sRow cnt (vla-GetText (car RowColList) eRow tempCntCol))
(vla-SetCellTextHeight TblObj sRow cnt (vla-GetCellTextHeight (car RowColList) eRow tempCntCol))
(vla-SetCellAlignment TblObj sRow cnt (vla-GetCellAlignment (car RowColList) eRow tempCntCol))
(setq cnt (1+ cnt))
(setq tempCntCol (1+ tempCntCol))
)
(setq eRow (1+ eRow))
(setq sRow (1+ sRow))
)
(vla-put-RegenerateTableSuppressed TblObj :vlax-false)
)
)
(setvar 'OsMode oOsMode)
(princ)
)