I've searched around and found a couple lisps that would find text and replace them (without a dialog). One exmple is from this forum post here: http://forums.augi.com/showthread.php?43053-Take-existing-drawings-and-find-all-quot-quot-and-replac... I have copied the code it below. I wanted to see if anyone could modify it to also find text inside of tables also which it doesn't seem to do.
Thanks!
;------------------------------------------------------------------------------- ; FindReplaceAll - Changes Text, Mtext, Dimensions and Attribute Block entities ; that have a Find$ string with a Replace$ string. ; Arguments: 2 ; Find$ = Phrase string to find ; Replace$ = Phrase to replace it with ; Syntax: (FindReplaceAll "old string" "new string") ; Returns: Updates Text, Mtext, Dimension and Attribute Block entities ;------------------------------------------------------------------------------- (defun c:FindReplaceAll (Find$ Replace$ / BlkEntList@ BlkEntName^ BlkEntType$ Cnt# DimEntList@ DimEntName^ DimEntType$ EntList@ EntName^ EntType$ FindReplace: Mid$ Mid2$ NewText$ Num# Replace$ SS& Text$) ;----------------------------------------------------------------------------- ; FindReplace: - Returns Str$ with Find$ changed to Replace$ ; Arguments: 3 ; Str$ = Text string ; Find$ = Phrase string to find ; Replace$ = Phrase to replace Find$ with ; Returns: Returns Str$ with Find$ changed to Replace$ ;----------------------------------------------------------------------------- (defun FindReplace: (Str$ Find$ Replace$ / Cnt# FindLen# Loop Mid$ NewStr$ ReplaceLen#) (setq Loop t Cnt# 1 NewStr$ Str$ FindLen# (strlen Find$) ReplaceLen# (strlen Replace$)) (while Loop (setq Mid$ (substr NewStr$ Cnt# FindLen#)) (if (= Mid$ Find$) (setq NewStr$ (strcat (substr NewStr$ 1 (1- Cnt#)) Replace$ (substr NewStr$ (+ Cnt# FindLen#))) Cnt# (+ Cnt# ReplaceLen#) );setq (setq Cnt# (1+ Cnt#)) );if (if (= Mid$ "") (setq Loop nil)) );while NewStr$ );defun FindReplace: ;----------------------------------------------------------------------------- ; Start of Main function ;----------------------------------------------------------------------------- (if (and (= (type Find$) 'STR)(= (type Replace$) 'STR)(/= Find$ "")) (progn (if (setq SS& (ssget "x" (list '(-4 . "<AND")'(-4 . "<OR")'(0 . "TEXT")'(0 . "MTEXT")'(0 . "DIMENSION")'(0 . "INSERT")'(-4 . "OR>")(cons 410 (getvar "CTAB"))'(-4 . "AND>")))) (progn (command "UNDO" "BEGIN") (setq Cnt# 0) (repeat (sslength SS&) (setq EntName^ (ssname SS& Cnt#) EntList@ (entget EntName^) EntType$ (cdr (assoc 0 EntList@)) Text$ (cdr (assoc 1 EntList@)) );setq (if (= EntType$ "INSERT") (if (assoc 66 EntList@) (progn (while (/= (cdr (assoc 0 EntList@)) "SEQEND") (setq EntList@ (entget EntName^)) (if (= (cdr (assoc 0 EntList@)) "ATTRIB") (progn (setq Text$ (cdr (assoc 1 EntList@))) (if (wcmatch Text$ (strcat "*" Find$ "*")) (progn (setq ReplaceWith$ (FindReplace: Text$ Find$ Replace$)) (entmod (subst (cons 1 ReplaceWith$) (assoc 1 EntList@) EntList@)) (entupd EntName^) );progn );if );progn );if (setq EntName^ (entnext EntName^)) );while );progn );if (if (wcmatch Text$ (strcat "*" Find$ "*")) (progn (setq ReplaceWith$ (FindReplace: Text$ Find$ Replace$)) (entmod (subst (cons 1 ReplaceWith$) (assoc 1 EntList@) EntList@)) (entupd EntName^) );progn );if );if (setq Cnt# (1+ Cnt#)) );repeat (command "UNDO" "END") );progn );if );progn );if (princ) );defun FindReplaceAll
Solved! Go to Solution.
Solved by CADaSchtroumpf. Go to Solution.
Solved by CADaSchtroumpf. Go to Solution.
Hi there,
Attached is an example drawing. I basicaly want to be able to do what the "FIND" command in autcad does where it will replace a text string with another text string. It would look at every text string in the drawing and replace it. It could be in blocks, nested blocks, tables, text, mtext, attributes, etc. The code I found above works on some items but not all (Not like the "FIND" command).
I'm really after a routine I can incorporate into my lisp program that would act as a function where I could have:
(c:FindReplaceText "old string" "new string")
Thanks!
In the example I posted, the oldstring would equal "xxxxxx" and would be replaced by the newstring "900999"
Hi,
With this, it seem to do work in object ACAD_TABLE
(defun my_replace_text (new_string old_string / js n ename) (vl-load-com) (defun string-subst (nam_obj / value_string nbs tmp_nbs) (setq value_string (vlax-get nam_obj 'TextString) nbs 0) (while nbs (if (setq nbs (vl-string-search old_string value_string (setq tmp_nbs nbs))) (setq value_string (vl-string-subst new_string old_string value_string tmp_nbs) nbs (1+ nbs) ) ) ) (vlax-put nam_obj 'TextString value_string) ) (defun tabl_subst (obj / eRows eColumns R C val nbs tmp_nbs) (setq eRows (vla-get-rows obj) eColumns (vla-get-columns obj) R 0 ) (repeat eRows (setq C 0) (repeat eColumns (setq val (vla-GetText obj R C) nbs 0 tmp_nbs nil) (while nbs (if (setq nbs (vl-string-search old_string val (setq tmp_nbs nbs))) (setq val (vl-string-subst new_string old_string val tmp_nbs) nbs (1+ nbs) ) ) ) (vla-SetText obj R C val) (setq C (+ C 1)) ) (setq R (+ R 1)) ) ) (setq js (ssget "_X" '( (-4 . "<OR") (0 . "*TEXT,MULTILEADER,ATTDEF,ACAD_TABLE") (-4 . "<AND") (0 . "INSERT") (66 . 1) (-4 . "AND>") (-4 . "OR>") ) ) ) (cond (js (repeat (setq n (sslength js)) (setq ename (vlax-ename->vla-object (ssname js (setq n (1- n))))) (cond ((vlax-property-available-p ename 'TextString) (string-subst ename) ) ((vlax-property-available-p ename 'Rows) (tabl_subst ename) ) (T (mapcar '(lambda (att) (string-subst att) ) (vlax-invoke ename 'GetAttributes) ) ) ) ) ) ) (prin1) )
Use (my_replace_text "900999" "xxxxxx")
This syntax can be used in a script for multiples drawings...
Hi CADAStroumph,
That does work great for tables and attributes. Would it be easy to adjust it so it will search and replace in blocks / nested blockes also? I think thats one of the only peices I'm missing.
Thanks!
so it will search and replace in blocks / nested blockes also?
You can try, just work's with attribut in nested blocks, after is hard to me to continue in nested block for table or other.
(defun my_replace_text (new_string old_string / js n ename first_blk l_blk n_blk) (vl-load-com) (defun xplore (l / ent cnt msg) (setq ent (entget (cdr (assoc -2 l))) cnt 0) (cond ((eq (cdr (assoc 0 ent)) "INSERT") (mapcar '(lambda (att) (string-subst att) ) (vlax-invoke (vlax-ename->vla-object (cdar ent)) 'GetAttributes) ) (while (setq ent (entnext (cdar ent))) (setq ent (entget ent)) (if (eq (cdr (assoc 0 ent)) "INSERT") (progn (setq cnt (1+ cnt)) (repeat cnt (mapcar '(lambda (att) (string-subst att) ) (vlax-invoke (vlax-ename->vla-object (cdar ent)) 'GetAttributes) ) ) ) ) ) ) ) ) (defun string-subst (nam_obj / value_string nbs tmp_nbs) (setq value_string (vlax-get nam_obj 'TextString) nbs 0) (while nbs (if (setq nbs (vl-string-search old_string value_string (setq tmp_nbs nbs))) (setq value_string (vl-string-subst new_string old_string value_string tmp_nbs) nbs (1+ nbs) ) ) ) (vlax-put nam_obj 'TextString value_string) ) (defun tabl_subst (obj / eRows eColumns R C val nbs tmp_nbs) (setq eRows (vla-get-rows obj) eColumns (vla-get-columns obj) R 0 ) (repeat eRows (setq C 0) (repeat eColumns (setq val (vla-GetText obj R C) nbs 0 tmp_nbs nil) (while nbs (if (setq nbs (vl-string-search old_string val (setq tmp_nbs nbs))) (setq val (vl-string-subst new_string old_string val tmp_nbs) nbs (1+ nbs) ) ) ) (vla-SetText obj R C val) (setq C (+ C 1)) ) (setq R (+ R 1)) ) ) (setq first_blk (tblnext "BLOCK" T)) (cond (first_blk (setq l_blk (list first_blk)) (while (setq n_blk (tblnext "BLOCK")) (setq l_blk (cons n_blk l_blk)) ) (foreach n l_blk (if (/= (logand (cdr (assoc 70 n)) 4) 4) (if (/= (logand (cdr (assoc 70 n)) 16) 16) (xplore n) ) ) ) ) ) (setq js (ssget "_X" '( (-4 . "<OR") (0 . "*TEXT,MULTILEADER,ATTDEF,ACAD_TABLE") (-4 . "<AND") (0 . "INSERT") (66 . 1) (-4 . "AND>") (-4 . "OR>") ) ) ) (cond (js (repeat (setq n (sslength js)) (setq ename (vlax-ename->vla-object (ssname js (setq n (1- n))))) (cond ((vlax-property-available-p ename 'TextString) (string-subst ename) ) ((vlax-property-available-p ename 'Rows) (tabl_subst ename) ) (T (mapcar '(lambda (att) (string-subst att) ) (vlax-invoke ename 'GetAttributes) ) ) ) ) ) ) (prin1) )
Thank you for your help CADStroumph! I appriciate it.
For people who have not done coding in a long long time, where do I incorporate my input for the text I want to replace?
The word after (defun at the top is the function name. The things after the left parenthesis following that and before the slash are the arguments that need to be supplied. So to use it, type in a left parenthesis followed by the function name followed by values for the arguments [which in this case must be text strings] followed by a right parenthesis. Note the order of the arguments. To replace "that" [the old string] with "this" [the new string]:
(my_replace_text "this" "that")