Copy Swap Text Autolisp
Copy Swap Text Autolisp
;;
;;
;; This program enables a user to either copy the text content from
;; a multitude of 'source' objects to a selection of 'destination'
;;
;;
;;
;;
;; To copy text, the program may be called with 'ctx' at the AutoCAD ;;
;; command line. The user may then select either a Text, MText,
;;
;;
;;
;;
;;
;;
;;
;; switch the text content between two objects. Upon calling the
;;
;; program with 'stx' at the command line, the user may select two
;; objects whose text content will be swapped.
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;----------------------------------------------------------------------;;
;; Author: Lee Mac, Copyright 2010 - www.lee-mac.com
;;
;;----------------------------------------------------------------------;;
;; Version 1.0
2010-12-16
;;
;;
;;
;; - First release.
;;
;;----------------------------------------------------------------------;;
;; Version 1.1
2010-12-17
;;
;;
;;
;;
;;
;;----------------------------------------------------------------------;;
;; Version 1.2
2010-12-20
;;
;;
;;
2011-01-05
;;
;;
;;
;;
;;----------------------------------------------------------------------;;
;; Version 1.4
2015-02-23
;;
;;
;;
;;
;;
;;----------------------------------------------------------------------;;
(defun copyswaptext ( flg / *error* des fun idx mt1 mt2 obj ret rgx src st1 st2 )
(copyswaptext:startundo (copyswaptext:acdoc))
(if (not (setq copyswaptext:retain (getenv "LMac\\copytext-retain")))
(setenv "LMac\\copytext-retain" (setq copyswaptext:retain "Yes"))
)
(if (setq src (copyswaptext:gettext (if flg "\nSelect text to swap [Settings/Exit]: "
"\nSelect source text [Settings/Exit]: ") "Settings Exit"))
(if (setq rgx (copyswaptext:regex))
(progn
)
)
)
)
(progn
(setq fun
(lambda ( obj mt1 mt2 ret )
(cond
)
)
)
(while
(progn
(setq des (copyswaptext:gettext "\nSelect destination text
[Multiple/Settings/Exit]: " "Multiple Settings Exit")
ret (= "Yes" copyswaptext:retain)
)
(cond
( (null des) nil)
( (= 'pickset (type des))
(repeat (setq idx (sslength des))
(setq obj (vlax-ename->vla-object (ssname des (setq idx
(1- idx)))))
(if (= "AcDbBlockReference" (vla-get-objectname obj))
(foreach att (vlax-invoke obj 'getattributes)
(fun att mt1 (copyswaptext:allowsformatting att)
ret)
)
(fun obj mt1 (copyswaptext:allowsformatting obj) ret)
)
)
nil
)
( (progn (fun (car des) mt1 (copyswaptext:allowsformatting
(car des)) ret) t))
)
)
)
)
)
)
)
)
(*error* nil)
(princ)
)
;;----------------------------------------------------------------------;;
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (or (null sel) (= "Exit" sel))
nil
)
( (= "Settings" sel)
(initget "Yes No")
(if (setq tmp (getkword (strcat "\nRetain mtext formatting? [Yes/No] <"
(getenv "LMac\\copytext-retain") ">: ")))
(setenv "LMac\\copytext-retain" (setq copyswaptext:retain tmp))
)
t
)
( (= "Multiple" sel)
(not
(setq rtn
(copyswaptext:ssget "\nSelect destination text <back>: "
'( "_:L"
(
(-4 . "<OR")
(0 . "TEXT,MTEXT,MULTILEADER")
(-4 . "<AND")
(00 . "INSERT")
(66 . 1)
(-4 . "AND>")
(-4 . "OR>")
)
)
)
)
)
)
( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 (entget
(car sel)))))))))
(princ "\nSelected object is on a locked layer.")
)
( (setq tmp (copyswaptext:gettextstring (car sel)))
(not (setq rtn (list (vlax-ename->vla-object (car sel)) tmp)))
)
( (princ "\nInvalid object selected."))
)
)
)
rtn
)
;;----------------------------------------------------------------------;;
(cond
( (wcmatch typ "TEXT,*DIMENSION")
(cdr (assoc 1 (reverse enx)))
)
( (and (= "MULTILEADER" typ)
(= acmtextcontent (cdr (assoc 172 (reverse enx))))
)
(cdr (assoc 304 enx))
)
( (wcmatch typ "ATTRIB,MTEXT")
(setq str (cdr (assoc 1 (reverse enx))))
(while (setq itm (assoc 3 enx))
(setq str (strcat (cdr itm) str)
enx (cdr (member itm enx))
)
)
str
)
)
)
;;----------------------------------------------------------------------;;
;;----------------------------------------------------------------------;;
actrue)
;;----------------------------------------------------------------------;;
(vl-catch-all-error-p
(setq rtn
(vl-catch-all-apply
'(lambda nil
(foreach pair
(if mtx
'(
("\032"
(" "
. "\\\\\\\\")
. "\\\\P|\\n|\\t")
("$1"
. "\\\\(\\\\[ACcFfHKkLlOopQTW])|\\\\
[ACcFfHKkLlOopQTW][^\\\\;]*;|\\\\[ACcFfKkHLlOopQTW]")
("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
("$1$2"
("$1"
. "\\\\(\\\\S)|[\\\\](})|}")
. "[\\\\]({)|{")
)
'(
("\032"
(""
. "\\\\")
. "%%[OoUu]")
)
)
(vlax-put-property rgx 'pattern (cdr pair))
(setq str (vlax-invoke rgx 'replace str (car pair)))
)
(mapcar
'(lambda ( lst / tmp )
(setq tmp str)
(foreach pair lst
. "\032")
("\\"
. "\032")
)
(
)
)
)
)
)
)
)
)
rtn
)
)
;;----------------------------------------------------------------------;;
;;----------------------------------------------------------------------;;
;;----------------------------------------------------------------------;;
;;----------------------------------------------------------------------;;
;;----------------------------------------------------------------------;;
(vl-load-com)
(princ
(strcat
"\n:: CopySwapText.lsp | Version 1.4 | \\U+00A9 Lee Mac "
(menucmd "m=$(edtime,0,yyyy)")
" www.lee-mac.com ::"
"\n:: \"ctx\" to Copy | \"stx\" to Swap ::"
)
)
(princ)
;;----------------------------------------------------------------------;;
;;
End of File
;;
;;----------------------------------------------------------------------;;