Ok, I think I have it working, now I would like someone to help me break it:
;*****************************************************************************************************************************************
; CopyText **
; Written by: Chris Wade **
; Version 3.0 **
; **
; - Bugs: Updating Tables are still slower than I would like. **
; **
;*****************************************************************************************************************************************
; Credits: **
; - Original code for modifying tables: Lee Abrosius - 03/24/04 **
; - Original code for crossing box from Kent1Cooper at http://discussion.autodesk.com/forums/thread.jspa?threadID=761481&tstart=0 **
; - Original code for processing MLeaders with Blocks from Lee Mac @ TheSwamp.org, CADTutor.net Copyright © 2010 by Lee McDonnell **
; - This code has been heavily modified for use within this routine. **
; - Code for Math functions by Lee Mac @ TheSwamp.org, CADTutor.net Copyright © Lee McDonnell, April 2010 **
; If you recognize any of your code, please let me know by sending me a PM at http://www.theswamp.org - cmwade77 **
;*****************************************************************************************************************************************
(defun c:ct (/ Msg Text StopLoop Input Data Code Pt1 Pt2 Formatting Ent Filter SS Increment Math Order)
(vl-load-com)
;Supporting Functions
(defun ct_Crossing (Pt1 Text Formatting Increment Math Order / Pt2 Filter SS)
(setq Pt2 (getcorner Pt1 "\rSelect opposite corner of crossing box: "))
(cond
(Pt2
(setq Filter '((-4 . "<OR") (0 . "TEXT") (0 . "MULTILEADER") (0 . "ACAD_TABLE") (0 . "*DIMENSION*") (0 . "MTEXT") (-4 . "<AND") (0 . "INSERT") (66 . 1) (-4 . "AND>") (-4 . "OR>"))
SS (ssget "_C" Pt1 Pt2 Filter)
)
(while (setq Ent (ssname SS 0))
(ct_SetText (ssname SS 0) Text Pt1 Pt2 Formatting)
(cond
(Increment
(setq Text (ct_Incr Text Increment Math Order))
)
)
(ssdel (ssname SS 0) SS)
)
)
)
)
(defun ct_Incr (MyString x *tMath* Ord / *error* ParseNumbers PerformOperation SubstAtN
DOC E ELST FUN I OP OPERAND O ORD SS TMP UFLAG X)
(vl-load-com)
;; Lee Mac ~ 09.04.10
(defun *error* (msg)
(and UFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(defun ParseNumbers (str / isString isNumber lst tmp)
(defun isString (x lst)
(cond ( (null lst) (list x))
( (< 47 (car lst) 58)
(cons x (isNumber (chr (car lst)) (cdr lst))))
( (= 45 (car lst))
(if (and (cadr lst)
(numberp
(read (setq tmp (strcat "-" (chr (cadr lst)))))))
(cons x (isNumber tmp (cddr lst)))
(isString (strcat x (chr (car lst))) (cdr lst))))
(t (isString (strcat x (chr (car lst))) (cdr lst)))))
(defun isNumber (x lst)
(cond ( (null lst) (list (read x)))
( (= 46 (car lst))
(if (and (cadr lst)
(numberp
(read (setq tmp (strcat x "." (chr (cadr lst)))))))
(isNumber tmp (cddr lst))
(cons (read x) (isString (chr (car lst)) (cdr lst)))))
( (< 47 (car lst) 58)
(isNumber (strcat x (chr (car lst))) (cdr lst)))
(t (cons (read x) (isString (chr (car lst)) (cdr lst))))))
(if (setq lst (vl-string->list str))
((if (or (and (= 45 (car lst))
(< 47 (cadr lst) 58))
(< 47 (car lst) 58)) isNumber isString) (chr (car lst)) (cdr lst))))
(defun PerformOperation (func str operand o)
(apply (function strcat)
(mapcar (function (lambda (x) (if (vl-position (type x) '(INT REAL))
(vl-princ-to-string (apply func (if o (list x operand)
(list operand x)))) x)))
(ParseNumbers str))))
(defun SubstAtN (new n lst)
(cond ( (null lst) nil)
( (zerop n) (cons new (cdr lst)))
( (cons (car lst) (SubstAtN new (1- n) (cdr lst))))))
(or *tMath* (setq *tMath* "Add"))
(setq op '(("Add" . +) ("Subtract" . -) ("Divide" . /) ("Multiply" . *)))
;(setq *tMath* "Add")
(setq fun (cdr (assoc *tMath* op)))
(if (and (zerop (rem x 1)) (not (eq '/ fun))) (setq x (fix x)))
;(setq MyString (getstring T "\nEnter string with a number in it: "))
(PerformOperation fun MyString x ord)
)
(defun ct_n2s (Num / Str Decimal StrLength)
(setq Str (rtos Num 2 12)
Decimal (vl-string-position (ascii ".") Str)
StrLength (strlen Str)
)
(while (and (> StrLength 0) (= (substr Str StrLength 1) "0"))
(setq StrLength (- StrLength 1))
)
(cond
((< (- StrLength Decimal) 0)
(rtos NUM 2 0)
)
(T
(rtos NUM 2 (- (- StrLength Decimal) 1))
)
)
)
(defun ct_GetText (/ Increment Math Str Text StopLoop Input Data Code Pick vHeight vWidth lwrLeft uprRight vector SS Table TableEnt Row Col Ent Object ObjectName ObjectBlock AttList Att Pt1 Pt2 TestPt1 XMIN XMAX YMIN YMAX InsPt1)
(setq Text "")
(cond
((= OldValue nil)
(setq OldValue ".")
)
)
(princ (strcat "\rSelect text to copy or type text <" OldValue ">: "))
(while (not StopLoop)
(setq Input (grread T 4 2)
Data (cadr Input)
Code (car Input)
)
(cond
((= Code 3)
(setq Pick (vlax-3d-point Data))
(cond
(Pick
(setq vHeight (getvar "viewsize")
vWidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vHeight)
lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2)) (- (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
uprRight (list (+ (nth 0 (getvar "viewctr")) (/ vWidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
vector (vlax-make-safearray vlax-vbDouble '(0 . 2))
)
(vlax-safearray-fill vector '(1 1 1))
(setq vector (vlax-make-variant vector))
(cond ; Check to see if selected point was on a Table
((setq SS (ssget "C" lwrleft uprRight (list (cons 0 "ACAD_TABLE"))))
(while (and (setq TableEnt (ssname SS 0)) (not StopLoop))
(setq Table (vlax-ename->vla-object TableEnt)
Row 0
Col 0
)
(cond
((= (vla-hittest Table Pick vector 'Row 'Col) :vlax-true)
(setq Text (vlax-invoke-method Table 'GetText Row Col)
StopLoop T
)
)
)
(ssdel (ssname SS 0) SS)
)
)
)
(cond ; If a table was not selected, do the following
((or (not Text) (= Text ""))
(setq Ent (nentselp "" Data))
(cond
(Ent
(setq Object (vlax-ename->vla-object (car Ent))
ObjectType (vla-get-ObjectName Object)
)
(cond
((= ObjectType "AcDbMLeader")
(cond
((/= (vla-get-contenttype Object) 1)
(setq Text (vla-get-textstring Object)
StopLoop T
)
)
(T
(defun LM:Itemp ( coll item )
;; © Lee Mac 2010
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply
(function vla-item) (list coll item)
)
)
)
)
item
)
)
(setq AttList (LM:Itemp (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-ContentBlockName Object))
InsPt1 (cdr (assoc 15 (entget (car Ent))))
)
(vlax-for Att AttList
(cond
((= (vla-get-objectname Att) "AcDbAttributeDefinition")
(setq Pt1 (polar Data (* pi (/ 45 180.0)) 0.13)
pt2 (polar Data (* pi (/ 225 180.0)) 0.13)
TestPt1 (polar (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Att))) (angle '(0 0 0) InsPt1) (distance '(0 0 0) InsPt1))
XMIN (MIN (CAR Pt1)(CAR pt2))
XMAX (MAX (CAR Pt1)(CAR pt2))
YMIN (MIN (CADR Pt1)(CADR pt2))
YMAX (MAX (CADR Pt1)(CADR pt2))
)
(cond
((and (< XMIN (CAR TestPt1))(> XMAX (CAR TestPt1)) (< YMIN (CADR TestPt1))(> YMAX (CADR TestPt1)))
(setq Text (vla-GetBlockAttributeValue Object (vla-get-ObjectID Att))
StopLoop T
)
)
)
)
)
)
)
)
)
((or (wcmatch ObjectType "*Text*") (wcmatch ObjectType "*Dimension*"))
(setq Text (vla-get-textstring Object)
StopLoop T
)
)
)
)
)
)
)
)
)
)
((= Code 2)
(if (not Str) (setq Str ""))
(cond
((<= 32 Data)
(setq Str (strcat Str (princ (chr Data))))
)
((and (> (strlen Str) 0) (= Data 8))
(setq Str (Substr Str 1 (- (strlen Str) 1)))
(princ (vl-list->string '(8 32 8)))
)
((= Data 13)
(setq Text Str
StopLoop T
)
)
)
)
((= Code 25)
(cond
((and Str (/= Str ""))
(setq Text Str)
)
)
(setq StopLoop T)
)
)
)
(cond
((or (not Text) (= Text ""))
(setq Text OldValue)
)
(T
(setq OldValue Text)
)
)
Text
)
(defun ct_SetText (Ent Text Pt1 Pt2 Formatting / Att AttList Pt3 Pt4 Object ObjectType Rows Columns cRow cColumn XMIN XMAX YMIN YMAX XMIN2 XMAX2 YMIN2 YMAX2 Pick LowerLeft1 UpperRight1 LowerLeft2 UpperRight2 Pick1 Pick2 TestPt1)
;ct_SetText Supporting Functions
(defun ct_ChangeTable (Pick Text Table / vHeight vWidth LwrLeft Uprright vector Ent2 Table Row Col StopLoop)
(setq vHeight (getvar "viewsize")
vWidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vHeight)
lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2)) (- (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
uprRight (list (+ (nth 0 (getvar "viewctr")) (/ vWidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
vector (vlax-make-safearray vlax-vbDouble '(0 . 2))
)
(vlax-safearray-fill vector '(1 1 1))
(setq vector (vlax-make-variant vector))
(setq Row 0
Col 0
)
(cond
((= (vla-hittest Table Pick Vector 'Row 'Col) :vlax-true)
(cond
((= (vlax-invoke-method Table 'GetCellType Row Col) acTextCell)
(vlax-invoke-method Table 'SetText Row Col Text)
(vlax-invoke-method Table 'Update)
)
)
)
)
)
(defun ct_Mid (pt1 pt2)
(mapcar '(lambda (x y) (* 0.5 (+ x y))) pt1 pt2)
)
;End of Supporting Functions
(setq Object (vlax-ename->vla-object Ent)
ObjectType (vla-get-ObjectName Object)
)
(cond
(Formatting
(setq Text (strcat Formatting Text))
)
)
(cond
((= ObjectType "AcDbTable")
(vla-put-RegenerateTableSuppressed Object :vlax-true)
(cond
((= Pt1 Pt2)
(ct_ChangeTable (vlax-3d-point Pt1) Text Object)
)
(T
(setq Rows (vla-get-rows Object)
Columns (vla-get-columns Object)
xMin (min (car Pt1) (car Pt2))
xMax (max (car Pt1) (car Pt2))
yMin (min (cadr Pt1) (cadr Pt2))
yMax (max (cadr Pt1) (cadr Pt2))
LowerLeft1 (list xMin yMin)
UpperRight1 (list xMax yMax)
Pick1 LowerLeft1
Row 0
Column 0
)
(while (< Column Columns)
(while (< Row Rows)
(setq Pick2 (vlax-safearray->list (vlax-variant-value (vla-getcellextents Object Row Column 0)))
Pt3 (list (nth 0 Pick2) (nth 1 Pick2))
Pt4 (list (nth 9 Pick2) (nth 10 Pick2))
xMin2 (min (car Pt3) (car Pt4))
xMax2 (max (car Pt3) (car Pt4))
yMin2 (min (cadr Pt3) (cadr Pt4))
yMax2 (max (cadr Pt3) (cadr Pt4))
LowerLeft2 (list xMin2 yMin2)
UpperRight2 (list xMax2 yMax2)
Pick (ct_mid Pt3 Pt4)
)
(cond
((and (or (<= (car LowerLeft1) (car LowerLeft2) (car UpperRight1)) (<= (car LowerLeft1) (car UpperRight2) (car UpperRight1))) (or (<= (cadr LowerLeft1) (cadr LowerLeft2) (cadr UpperRight1)) (<= (cadr LowerLeft1) (cadr UpperRight2) (cadr UpperRight1))))
(ct_ChangeTable (vlax-3d-point Pick) Text Object)
)
)
(setq Row (+ Row 1))
)
(setq Column (+ Column 1)
Row 0
)
)
)
)
(vla-put-RegenerateTableSuppressed Object :vlax-false)
)
((= ObjectType "AcDbBlockReference")
(setq XMIN (MIN (CAR pt1)(CAR pt2))
XMAX (MAX (CAR pt1)(CAR pt2))
YMIN (MIN (CADR pt1)(CADR pt2))
YMAX (MAX (CADR pt1)(CADR pt2))
AttList (vlax-safearray->list (vlax-variant-value (vla-getattributes Object)))
)
(foreach Att AttList
(setq TestPt1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Att))))
(cond
((and (< XMIN (CAR TestPt1))(> XMAX (CAR TestPt1)) (< YMIN (CADR TestPt1))(> YMAX (CADR TestPt1)))
(vla-put-textstring att text)
)
)
)
)
((= ObjectType "AcDbMLeader")
;(alert "works")
(cond
((= (vla-get-contenttype Object) 1)
(defun LM:Itemp ( coll item )
;; © Lee Mac 2010
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply
(function vla-item) (list coll item)
)
)
)
)
item
)
)
(setq AttList (LM:Itemp (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-ContentBlockName Object))
InsPt1 (cdr (assoc 15 (entget Ent)))
)
(vlax-for Att AttList
(cond
((= (vla-get-objectname Att) "AcDbAttributeDefinition")
(setq mlPt1 (polar Pt1 (* pi (/ 45 180.0)) 0.13)
mlpt2 (polar Pt2 (* pi (/ 225 180.0)) 0.13)
TestPt1 (polar (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Att))) (angle '(0 0 0) InsPt1) (distance '(0 0 0) InsPt1))
XMIN (MIN (CAR mlPt1)(CAR mlpt2))
XMAX (MAX (CAR mlPt1)(CAR mlpt2))
YMIN (MIN (CADR mlPt1)(CADR mlpt2))
YMAX (MAX (CADR mlPt1)(CADR mlpt2))
)
(cond
((and (< XMIN (CAR TestPt1))(> XMAX (CAR TestPt1)) (< YMIN (CADR TestPt1))(> YMAX (CADR TestPt1)))
(vla-SetBlockAttributeValue Object (vla-get-ObjectID Att) Text)
)
)
)
)
)
)
(T
(vla-put-textstring Object Text)
)
)
)
((wcmatch ObjectType "*Dimension*")
(vla-put-textoverride Object Text)
)
(T
(vla-put-textstring Object Text)
)
)
)
;End Supporting functions
(setq Msg "")
(setq Text (ct_GetText))
(cond
(Text
(while (not StopLoop)
(setq Msg (strcat "\rSelect text to copy to or [New value"))
(cond
(Formatting
(setq Msg (strcat Msg "/** Formatting **"))
)
(T
(setq Msg (strcat Msg "/Formatting"))
)
)
;(cond
; (Math
; (setq Msg (strcat Msg "/** Math mode: " Math " **"))
; )
; (T
; (setq Msg (strcat Msg "/Math mode"))
; )
;)
(cond
(Increment
(setq Msg (strcat Msg "/** increment " (ct_n2s Increment) " (+/-) **"))
)
(T
(setq Msg (strcat Msg "/increment (+/-)"))
)
)
(setq Msg (strcat Msg "] <" Text ">: "))
(princ Msg)
(setq Input (grread T 4 2)
Data (cadr Input)
Code (car Input)
)
(cond
((= Code 2);If there was keyboard input, then do this
(cond
((or (= Data 110) (= Data 78))
(setq Text (ct_GetText))
)
((or (= Data 99) (= Data 67))
(ct_Crossing Pt1 Text Formatting Increment Math Order)
)
((or (= Data 70) (= Data 102))
(setq Formatting (getstring T "\nType the formmating code to add: "))
)
((= Data 43)
(cond
((not Increment)
(setq Increment 0)
)
)
(setq Increment (+ Increment 1))
(cond
((not Math)
(setq Math "Add")
)
)
(cond
((= Increment 0)
(setq Increment nil
Math nil
)
)
)
)
((= Data 45)
(cond
((not Increment)
(setq Increment 0)
)
)
(setq Increment (- Increment 1))
(cond
((not Math)
(setq Math "Add")
)
)
(cond
((= Increment 0)
(setq Increment nil
Math nil
)
)
)
)
)
)
((= Code 3)
(setq Pt1 Data
Ent (nentselp "" Pt1))
(cond
(Ent ; If Object is selected, run this
(setq Filter '((-4 . "<OR") (0 . "*DIMENSION*") (0 . "ACAD_TABLE") (-4 . "OR>"))
SS (ssget Pt1 Filter)
)
(cond
(SS
(while (setq Ent (ssname SS 0))
(ct_SetText (ssname SS 0) Text Pt1 Pt1 Formatting)
(cond
(Increment
(setq Text (ct_Incr Text Increment Math Order))
)
)
(ssdel (ssname SS 0) SS)
)
)
(T
(ct_SetText (car Ent) Text Pt1 Pt1 Formatting)
(cond
(Increment
(setq Text (ct_Incr Text Increment Math Order))
)
)
)
)
)
(T ; If blank space is selected, run this
(ct_Crossing Pt1 Text Formatting Increment Math Order)
)
)
)
)
)
)
)
)
I didn't go with the labda stuff, because to be honest, I didn't quite get how that one works, if someone can explain it, I would appreciate it.