bustr Posted July 29, 2019 Share Posted July 29, 2019 Is there a way to replace text and attribute values without this dialogue box? I have several values that need to be replaced and the lisp routine that I ordinarily use is not working. The text of the lisp is below the picture. (defun c:REPLACER () (setq ss_blk (ssget "x" '((0 . "INSERT") (66 . 1)))) (if ss_blk (progn (setq lst_blk (sel2lst ss_blk)) (foreach en_blk lst_blk (setq lst_atts (att2lst en_blk)) (setq str_line "") (foreach en_atts lst_atts (setq str_line (getval 1 en_atts)) (if (not (wcmatch str_line "*/*/*")) (progn (setq str_line (strchg str_line "06/13/19" "07/26/19")) (setq str_line (strchg str_line "06/14/19" "07/26/19")) (setq str_line (strchg str_line "07/22/19" "07/26/19")) (setval 1 str_line en_atts) ) ) ) ) ) ) (setq ss_txtlines (ssget "x" '((0 . "TEXT")))) (if ss_txtlines (progn (setq lst_txtlines (sel2lst ss_txtlines)) (setq str_line "") (foreach en_txtlines lst_txtlines (setq str_line (getval 1 en_txtlines)) (if (not (wcmatch str_line "*/*/*")) (progn (setq str_line (strchg str_line "06/13/19" "07/26/19")) (setq str_line (strchg str_line "06/14/19" "07/26/19")) (setq str_line (strchg str_line "07/22/19" "07/26/19")) (setval 1 str_line en_txtlines) ) ) ) ) ) ) Quote Link to comment Share on other sites More sharing options...
Steven P Posted July 29, 2019 Share Posted July 29, 2019 Try this, use the command txtreplace: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:txtreplace( / old_text new_text) (setq old_text (getstring T "OLD Text to replace (replace in this model/paper space and text case as entered): ")) (setq new_text (getstring T "NEW text to use: ")) (FindReplaceAll old_text new_text) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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 ; It is Case sensitive ;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-and-replace-text/td-p/5649883 ;------------------------------------------------------------------------------- (defun 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Quote Link to comment Share on other sites More sharing options...
bustr Posted July 29, 2019 Author Share Posted July 29, 2019 Thanks. Where in the code do I place the old and new values? Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 30, 2019 Share Posted July 30, 2019 a hint Syntax: (FindReplaceAll "old string" "new string") 1 Quote Link to comment Share on other sites More sharing options...
SLW210 Posted July 30, 2019 Share Posted July 30, 2019 I have moved your thread to the AutoLISP, Visual LISP & DCL Forum. Please post in the most appropriate forum. Quote Link to comment Share on other sites More sharing options...
dlanorh Posted July 30, 2019 Share Posted July 30, 2019 Or try this (defun c:REPLACER ( / o_lst n_lst ss_blk cnt blk atts n ss_txt obj) (setq o_lst (list "06/13/19" "06/14/19" "07/22/19") n_lst (list "07/26/19" "07/26/19" "07/26/19") ss_blk (ssget "x" '((0 . "INSERT") (66 . 1))) );end_setq (cond (ss_blk (repeat (setq cnt (sslength ss_blk)) (setq blk (vlax-ename->vla-object (ssname ss_blk (setq cnt (1- cnt)))) atts (vlax-invoke blk 'getattributes) );end_setq (foreach att atts (if (setq n (vl-position (vlax-get-property att 'textstring) o_lst)) (vlax-put-property att 'textstring (nth n n_lst))) );end_foreach );end_repeat ) );end_cond (setq ss_txt (ssget "x" '((0 . "TEXT")))) (cond (ss_txt (repeat (setq cnt (sslength ss_txt)) (setq obj (vlax-ename->vla-object (ssname ss_txt (setq cnt (1- cnt))))) (if (setq n (vl-position (vlax-get-property obj 'textstring) o_lst)) (vlax-put-property obj 'textstring (nth n n_lst))) );end_repeat ) );end_cond (princ) );end_defun (vl-load-com) (princ) 1 Quote Link to comment Share on other sites More sharing options...
bustr Posted July 30, 2019 Author Share Posted July 30, 2019 Thanks dlanorh. That worked. Quote Link to comment Share on other sites More sharing options...
dlanorh Posted July 30, 2019 Share Posted July 30, 2019 13 minutes ago, bustr said: Thanks dlanorh. That worked. No problems. Do you understand how the two lists (old) o_lst and (new) n_lst work? Quote Link to comment Share on other sites More sharing options...
bustr Posted July 30, 2019 Author Share Posted July 30, 2019 Yes. Thanks! Quote Link to comment Share on other sites More sharing options...
dlanorh Posted July 30, 2019 Share Posted July 30, 2019 7 minutes ago, bustr said: Yes. Thanks! OK. If your want to use this with alphabetical text two lines would require changes The if statement here should be : (foreach att atts (if (setq n (vl-position (strcase (vlax-get-property att 'textstring)) (mapcar 'strcase o_lst))) (vlax-put-property att 'textstring (nth n n_lst))) );end_foreach And likewise here (if (setq n (vl-position (strcase (vlax-get-property obj 'textstring)) (mapcar 'strcase o_lst))) (vlax-put-property obj 'textstring (nth n n_lst))) 1 Quote Link to comment Share on other sites More sharing options...
bustr Posted July 30, 2019 Author Share Posted July 30, 2019 That works. Thanks again! Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.