I am still not getting how to do this part of it, here's my most current code, in case someone can help me figure out the mleaders with multiple attributes issues:
;Written By Chris Wade
; 2010-02-15
; Copies Text
; Table modifications uses modified code from:
;; Written by Lee Ambrosius
;; Date: 3/24/04
;; Checks for tables in current view to match up with HitTest
;; This avoids the need for the user to select the table first.
;; Program is provided AS-IS with no expressed written warranty
;; This example demonstrates a couple of the new Table ActiveX properties
;; HitTest, GetCellType, GetText and SetText
(defun c:ct ( / vector table pick row col cellValueOrg StopLoop SS_tables cnt emax Modified cwset Crossing Inc)
(setq vHeight (getvar "viewsize"))
(setq vWidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vHeight))
(setq lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2)) (- (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0))
(setq uprRight (list (+ (nth 0 (getvar "viewctr")) (/ vWidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0))
(setq vector (vlax-make-safearray vlax-vbDouble '(0 . 2)))
(vlax-safearray-fill vector '(1 1 1))
(setq vector (vlax-make-variant vector))
(princ "\n")
(defun GetText ()
(setq str "")
(cond
((= oValue nil)
(setq oValue ".")
)
)
(prompt (strcat "\rSelect Text/Cell to Copy or type Text <" oValue ">: "))
; Code for typing text used from DTCurve command
;; AUTHOR: ;;
;; ;;
;; Copyright © Lee McDonnell, November 2009. All Rights Reserved. ;;
;; ;;
;; { Contact: Lee Mac @ TheSwamp.org, CADTutor.net } ;;
(while (= StopLoop nil)
(setq input (grread T 4 2)
data (cadr input)
code (car input))
(cond
((= (car input) 3)
(setq oValue nil)
(setq pick (vlax-3d-point (cadr input)))
(if (/= pick nil)
(progn
(if (setq SS_TABLES (ssget "C" lwrleft uprright (list (cons 0 "ACAD_TABLE"))))
(progn
(setq cnt 0 eMax (sslength SS_TABLES))
(while (> eMax cnt)
(setq table (vlax-ename->vla-object (ssname SS_TABLES cnt)))
;; Return values for what cell was picked in
(setq row 0 col 0)
;; Check to see if a valid cell was picked
(if (= (vla-hittest table pick vector 'row 'col) :vlax-true)
(progn
;; Check to see what the Cell Type is (Text or Block)
(if (= (vlax-invoke-method table 'GetCellType row col) acTextCell)
(progn
;; Let's get the value out
(setq OValue (vlax-invoke-method table 'GetText row col))
(setq cnt eMax)
)
)
)
)
(setq cnt (1+ cnt))
)
)
)
)
)
(cond
((= Ovalue nil)
(setq obj (nentselp "" (cadr input)))
(cond
((/= obj nil)
(setq obj (vlax-ename->vla-object (car obj))
ovalue (vla-get-textstring obj))
)
)
)
)
(cond
((/= Ovalue nil)
(setq StopLoop T)
)
)
)
((= 25 code)
(if (and (/= str "") (/= str nil) (/= str null))
(setq oValue str str nil)
)
(setq StopLoop T)
)
((= 2 code)
(cond
((<= 32 data)
(setq str (strcat str (princ (chr data))))
)
((and (< 0 (strlen str)) (= 8 data))
(setq str (substr str 1 (1- (strlen str))))
(princ (vl-list->string '(8 32 8))))
((= 13 data)
(if (and (/= str "") (/= str nil) (/= str null))
(setq oValue str str nil)
)
(setq StopLoop T)
)
)
)
)
)
oValue
)
(defun ChangeText (obj2 text pt pt2 / obj obj3 obj4 ATT ObjTyp ObjBKName row2 col2 Columns rows2 pick pta ptb xmax xmin ymax ymin ss cnt CPt Sel EntData Ent EditList cnt Num Str tempList)
(setq Obj (vlax-ename->vla-object obj2)
ObjTyp (vla-get-ObjectName obj)
cnt 0)
(cond
((= ObjTyp "AcDbTable")
(setq Rows2 (vla-get-rows obj)
Columns (vla-get-columns obj)
XMIN (MIN (CAR pt)(CAR pt2))
XMAX (MAX (CAR pt)(CAR pt2))
YMIN (MIN (CADR pt)(CADR pt2))
YMAX (MAX (CADR pt)(CADR pt2))
LLB (list XMIN YMIN)
URB (list XMAX YMAX)
pick (list xmin ymin)
Row2 -1
Col2 -1)
(while (< col2 (- Columns 1))
(setq Col2 (+ col2 1))
(while (< row2 (- rows2 1))
(setq row2 (+ row2 1)
pick2 (vlax-safearray->list (vlax-variant-value (vla-getcellextents obj row2 col2 0)))
pta (list (nth 0 pick2) (nth 1 pick2))
ptb (list (nth 9 pick2) (nth 10 pick2))
LLA (list (car pta) (cadr ptb))
URA (list (car ptb) (cadr pta))
pick (midpnt pta ptb))
(if ; Code for crossing box from Kent1Cooper at http://discussion.autodesk.com/forums/thread.jspa?threadID=761481&tstart=0
(and
(or
(<= (car LLB) (car LLA) (car URB))
(<= (car LLB) (car URA) (car URB))
); end or
(or
(<= (cadr LLB) (cadr LLA) (cadr URB))
(<= (cadr LLB) (cadr URA) (cadr URB))
); end or
); end and
(ChangeTable (vlax-3d-point pick) oValue lwrleft uprright)
); end if
)
(setq row2 -1)
)
)
((= ObjTyp "AcDbBlockReference")
(cond
((= pt2 nil)
(setq Obj (vlax-ename->vla-object (car (nentselp "" pt))))
(vla-put-textstring obj text)
)
(T
(setq XMIN (MIN (CAR pt)(CAR pt2))
XMAX (MAX (CAR pt)(CAR pt2))
YMIN (MIN (CADR pt)(CADR pt2))
YMAX (MAX (CADR pt)(CADR pt2))
AttList (vlax-variant-value (vla-getattributes obj)))
(foreach Att (vlax-safearray->list AttList)
(setq tpt (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint att))))
(cond
((and (< XMIN (CAR tpt))(> XMAX (CAR tpt)) (< YMIN (CADR tpt))(> YMAX (CADR tpt)))
(vla-put-textstring att text)
)
)
)
)
)
)
((= ObjTyp "AcDbMLeader")
(setq ObjBKName (vla-get-ContentBlockName obj)
ins_pt (osnap pt "_ins"))
(cond
((or (= ObjBKName "") (= ObjBKName nil) (= ObjBKName null))
(vla-put-textstring obj text)
)
(T
(cond
((= pt2 nil)
(setq ss (ssget pt))
)
(T
(setq ss (ssget "_C" pt pt2))
)
)
(cond ; Code for adjusting mleaders with attributes in them modified from code by T.Willey at http://www.theswamp.org/index.php?topic=32152.msg376440#msg376440
((/= ss nil)
(while (< cnt (sslength ss))
(if
(and
(setq Sel (ssname ss Cnt))
(setq EntData (entget (setq Ent Sel)))
(= (cdr (assoc 0 EntData)) "MULTILEADER")
)
(progn
(foreach i EntData
;(setq tpt (cdr (assoc 10 (entget (cdr i)))))
; ins_pt (osnap pt "_ins"))
; (cond
; ((= pt2 nil)
; (if (and (= (car tpt) (car ins_pt)) (= (cadr tpt) (cadr ins_pt)))
; (setq Cpt T)
; (setq Cpt nil)
; )
; )
; (T
; (if (and (< XMIN (CAR tpt))(> XMAX (CAR tpt)) (< YMIN (CADR tpt))(> YMAX (CADR tpt)))
; (setq Cpt T)
; (setq Cpt nil)
; )
; )
; )
(if
(and
(equal (car i) 330)
(equal (type (cdr i)) 'ENAME)
(= (cdr (assoc 0 (entget (cdr i)))) "ATTDEF")
)
(setq EditList
(cons
(list
i
(assoc 177 (member i EntData))
(assoc 302 (member i EntData))
)
EditList
)
)
)
)
)
)
(if EditList
(progn
(setq cnt 0)
(setq EditList (reverse EditList))
(foreach i EditList
(prompt
(strcat
"\n "
(itoa cnt)
" - "
(cdr (assoc 3 (entget (cdar i))))
" <"
(cdaddr i)
">: "
)
)
(setq cnt (1+ cnt))
)
(textscr)
(if
(and
(< -1 (setq Num (getint (strcat "\rEnter number of value to edit [0 - " (itoa (1- cnt)) "]: "))) cnt)
(setq tempList (nth Num EditList))
)
(entmod
(mapcar
(function
(lambda ( x )
(if (equal x (cadr tempList))
(setq flag T)
)
(if
(and
flag
(equal (caddr tempList) x)
)
(progn
(setq flag nil)
(cons 302 text)
)
x
)
)
)
EntData
)
)
)
(graphscr)
)
)
(setq cnt (+ cnt 1))
)
)
)
)
)
)
((= (wcmatch ObjTyp "*Dimension*") T)
(vla-put-TextOverride obj text)
)
(T
(vla-put-textstring obj text)
)
)
)
(defun ChangeTable (pick oValue lwrleft uprright)
(if (setq SS_TABLES (ssget "C" lwrleft uprright (list (cons 0 "ACAD_TABLE"))))
(progn
(setq cnt 0 eMax (sslength SS_TABLES))
(while (> eMax cnt)
(setq table (vlax-ename->vla-object (ssname SS_TABLES cnt)))
;; Return values for what cell was picked in
(setq row 0 col 0)
;; Check to see if a valid cell was picked
(if (= (vla-hittest table pick vector 'row 'col) :vlax-true)
(progn
;; Check to see what the Cell Type is (Text or Block)
(if (= (vlax-invoke-method table 'GetCellType row col) acTextCell)
(progn
;; Change the current value
(vlax-invoke-method table 'SetText row col OValue)
(vlax-invoke-method table 'Update)
(setq Modified T)
(setq cnt eMax)
)
)
)
)
(setq cnt (1+ cnt))
)
)
)
)
(setq oValue (GetText))
(setq StopLoop nil)
(if (= inc nil)
(setq inc 0)
)
(while (= StopLoop nil)
(setq Modified nil
input (grread T 4 2))
(prompt (strcat "\rSelect Text or Cell to Overwrite <New text/Crossing/+ or - to change current increment of " (n2s Inc) "> (Current Value is: " oValue "): "))
(cond
((and (= (car input) 2) (or (= (cadr input) 99) (= (cadr input) 67)))
(setq Crossing T)
)
((and (= (car input) 2) (= (cadr input) 43))
(setq Inc (+ Inc 1))
(if (/= Inc 0)
(setq oValue (incr oValue Inc))
)
)
((and (= (car input) 2) (= (cadr input) 45))
(setq Inc (- Inc 1))
(if (/= Inc 0)
(setq oValue (incr oValue Inc))
)
)
((and (= (car input) 2) (or (= (cadr input) 110) (= (cadr input) 78)))
(setq oValue (GetText)
StopLoop nil)
)
((or (= (car input) 3) (= Crossing T))
(cond
((= Crossing nil)
(setq pick (vlax-3d-point (cadr input)))
(ChangeTable pick oValue lwrleft uprright)
(cond
((= Modified nil)
(setq point2 (trans (cadr input) 1 0))
(setq cwset nil)
(setq cwset (ssget (cadr input)))
(cond
((/= cwset nil)
(setq obj (ssname cwset 0)
cnt eMax)
(ChangeText obj oValue point2 nil)
(setq point2 nil)
)
(T
(setq Crossing T)
)
)
)
)
(if (/= Inc 0)
(setq oValue (incr oValue Inc))
)
)
(T
(if (= point2 nil)
(setq point2 (getpoint "\rSelect first corner of crossing box: "))
)
(setq point3 (getcorner point2 "\rSelect opposite corner of crossing box: ")
flt '((-4 . "<OR") (0 . "TEXT") (0 . "MULTILEADER") (0 . "ACAD_TABLE") (0 . "*DIMENSION*") (0 . "MTEXT") (-4 . "<AND") (0 . "INSERT") (66 . 1) (-4 . "AND>") (-4 . "OR>"))
cwset (ssget "_C" point2 point3 flt)
ct 0)
(cond
((/= cwset nil)
(while (< ct (sslength cwset))
(setq obj (ssname cwset ct)
ct (+ ct 1))
(ChangeText obj oValue point2 point3)
(if (/= Inc 0)
(setq oValue (incr oValue Inc))
)
)
)
(T
(alert "You didn't select anything to change!")
)
)
(setq Crossing nil
point2 nil)
)
)
)
)
)
(princ)
)
(defun midpnt (pt1 pt2)
(mapcar '(lambda (x y) (* 0.5 (+ x y))) pt1 pt2)
)
(defun N2S (NUM / Temp DcPt Cr CP); Converts Number to String, retaining appropriate number of decimal places
(setq Temp (rtos NUM 2 12)
DcPt (vl-string-position (ascii ".") Temp)
Cr (strlen Temp))
(while (and (> Cr 0) (= (substr Temp Cr 1) "0"))
(setq Cr (- Cr 1))
)
(if (< (- Cr DcPt) 0)
(setq CP 0)
(setq CP (- (- Cr DcPt) 1))
)
(rtos NUM 2 CP)
)
(defun incr (Text Inc / ct Tst Min Max StopLoop OrigText TempText NewText Increased)
(setq ct (strlen Text)
x (- ct 1)
Tst (ascii (substr Text ct 1)))
(cond
((and (>= Tst 48) (<= Tst 57)); Numeric
(setq Min 48
Max 57)
)
((and (>= Tst 65) (<= Tst 90)); Upper Case Text
(setq Min 65
Max 90)
)
((and (>= Tst 97) (<= Tst 122)); Lower Case Text
(setq Min 97
Max 122)
)
)
(while (and (> x 0) (= StopLoop nil))
(setq Tst (ascii (substr Text x 1)))
(if (not (or (and (>= Tst Min) (<= Tst Max)) (= Tst 46)))
(setq StopLoop T)
(setq x (- x 1))
)
)
(setq OrigText (substr Text (+ x 1))
ct (strlen OrigText)
x ct)
(cond
((and (>= Min 48) (<= Max 57))
(setq TempText (N2S (+ (atof OrigText) Inc)))
)
(T
(cond
((> inc 0)
(while (> x 0)
(setq Tst (ascii (substr OrigText x 1)))
(if (= Increased nil)
(progn
(if (<= Tst (- Max inc))
(progn
(if (= TempText nil)
(setq TempText (chr (+ Tst inc)))
(setq TempText (strcat (chr (+ Tst inc)) TempText))
)
(setq Increased T)
)
(progn
(if (= TempText nil)
(setq TempText (chr Min))
(setq TempText (strcat (chr Min) TempText))
)
)
)
)
(progn
(if (= TempText nil)
(setq TempText (chr Tst))
(setq TempText (strcat (chr Tst) TempText))
)
)
)
(setq x (- x 1))
)
)
((< inc 0)
(while (> x 0)
(setq Tst (ascii (substr OrigText x 1)))
(if (= Increased nil)
(progn
(if (>= Tst (- Min inc))
(progn
(if (= TempText nil)
(setq TempText (chr (+ Tst inc)))
(setq TempText (strcat (chr (+ Tst inc)) TempText))
)
(setq Increased T)
)
(progn
(if (= TempText nil)
(setq TempText (chr Min))
(setq TempText (strcat (chr Min) TempText))
)
)
)
)
(progn
(if (= TempText nil)
(setq TempText (chr Tst))
(setq TempText (strcat (chr Tst) TempText))
)
)
)
(setq x (- x 1))
)
)
)
)
)
(setq NewText (vl-string-subst TempText OrigText Text))
NewText
)