This seems to work for TT fonts.
Any better ideas?
;; CAB 06.09.09
;; This is a test routine for Changing the text within a Table
;; Note that fields are not dealt with is this version
;;
(defun c:tu () (c:TableUpdate))
(defun c:TableUpdate (/ entity txt_str tblent e-type n
ti val ent elst column hitpt
hitres row vlaobj tblRC
gettext HuntForTable UpdateCell
)
;; User selection of source text string
(defun gettext (/ ent elst txt)
(setvar "errno" 0)
(while
(cond
((null (setq ent (nentsel "\n* Select Source Text *")))
(princ "\nMissed, try again.")
)
((= 52 (getvar "errno"))
(prompt "\n*** User Quit ***\n")
(setq txt nil) ; exit loop
)
((and
(setq elst (entget (car ent)))
(= (type (setq txt (cdr (assoc 1 elst)))) 'STR)
)
(princ (strcat "\** Got new source text: \"" txt "\""))
nil ; exit loop
)
((princ "\n*** No Text Found ***\n")
(setq txt nil)
t
) ; stay in loop
)
)
txt
)
;; See if point is within a table, if so
;; return a list of Hits '((TableObject Row Column ) .....)
(defun HuntForTable (pt / vCtr vSize vHs ll ur ss i ename TblList tblHit vDir vpt)
;; get coordenates of screen CAB 12/7/06
(setq vCtr (getvar "VIEWCTR") ; UCS
vSize (/ (getvar "VIEWSIZE") 2.0) ; UCS
vHs (* vSize (apply '/ (getvar "screensize")))
)
(setq ll (list (- (car vCtr) vHs) (- (cadr vCtr) vSize)))
(setq ur (list (+ (car vCtr) vHs) (+ (cadr vCtr) vSize)))
;; get a selection set of TABLES in screen
;; make a list of objects selected
;; test the tables to see if the point is within them
(if (setq ss (ssget "_C" ur ll '((0 . "ACAD_TABLE"))))
(progn
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq TblList (cons (vlax-ename->vla-object ename) TblList))
)
(setq pt (trans pt 1 0)
vpt (vlax-3d-point pt)
vDir (vlax-3d-point (getvar "viewdir"))
)
(mapcar
(function
(lambda (tbl / row col)
(if (= :vlax-true (vla-hittest tbl vpt vDir 'Row 'Col))
(setq TblHit (cons (list tbl Row Col) TblHit))
)
)
)
TblList
)
)
)
tblHit
)
;; returns t if successful
(defun UpdateCell (tbl r c txt)
(if (vl-catch-all-error-p
(vl-catch-all-apply
'vla-SetText (list tbl R C txt)))
(prompt "\n Can't paste. Object may be on locked layer. ")
t
)
)
;;**********************************************************
;(if (setq txt_str (gettext))
(if (setq txt_str "My Test") ; debug
(while
(progn
(setvar "errno" 0)
(initget "Change")
(setq entity (nentsel "\n* Select Text in Table to Change *"))
(cond
;;.......................................
((= 52 (getvar "errno")) ; Enter Key
(prompt "\n*** User Quit ***\n")
)
;;.......................................
((and (null entity) ; ? missed pick, test for table
(eq 5 (car (setq pt (grread t 8 0)))) ; got a point
(setq TblRC (HuntForTable (cadr pt))) ; got a table
)
;; No suport for more than one table found at this time
(setq TblRC (car TblRC)) ; debug
(if (not (UpdateCell (car TblRC)(cadr TblRC)(caddr TblRC) Txt_Str))
(prompt "\n*** Could Not Update Table ***")
)
t
)
;;.......................................
((null entity) (princ "\nMissed Pick, Try again."))
((= entity "Change") ; allow user to select new source text
(setq txt_str (gettext))
)
;;.......................................
((and entity (listp entity)(> (length entity) 3))
(setq tblent (car (last entity))
e-type (cdr (assoc 0 (entget tblent)))
)
(cond
;; BLOCK not included in test routine
((= e-type "ACAD_TABLE") ; got a table with a pick point
(setq vlaObj (vlax-ename->vla-object
(cdr (assoc -1 (entget (car (last entity)))))
)
hitPt (vlax-3D-Point (trans (cadr entity) 1 0))
hitRes (vla-HitTest vlaObj hitPt
(vlax-3d-point (getvar "viewdir")) 'Row 'Column)
) ; end setq
(if
(and
(= :vlax-true hitRes)
(= (vla-GetCellType vlaObj row column) acTextCell)
)
(UpdateCell vlaObj row column Txt_Str)
(princ "\n*** Could Not Update Table ***")
) ; end if
)
)
t
)
)
)
) ; end while
)
(princ)
)
(prompt "\nTable Test ")
(princ)
