Replace multiple textstring

[Zykl0]

Hello,

 

I try to find a lisp that will search and replace text within a user selection.

This piece of code that I found on a very old forums on the net do almost exactly what I need.

The only issue is I want to replace single word inside sentence and this code replace the word only if it's alone.

 

(defun c:TRANSLATE()
(command "cmdecho" "0")
(command "_.undo" "begin")
(setq mylist (list
(list "APPLE" "PEAR")
(list "BANANA" "STRAWBERRY")
)
)
(setq sset (ssget '((0 . "TEXT"))))
(setq i 0)
(while (< i (sslength sset))
 (setq obj (ssname sset i))
 (setq str (cdr (assoc 1 (setq lst (entget obj)))))
(princ str)
 (princ "\n")
(foreach item mylist
   (if (eq str (nth 0 item))
     (progn
     (setq newstr (nth 1 item))
  	  (if newstr
   		(entmod (subst (cons 1 newstr)(assoc 1 lst) lst))
 	  )
     )
   )
)
 (setq i (1+ i))
)
(command "cmdecho" "1")
(command "_.undo" "end")
)

 

Can someone modify it to make it work for me?

 

Thank you

[ronjonp]

Quick mod:

(defun c:translate (/ el mylist sset str)
 (command "cmdecho" "0")
 (command "_.undo" "begin")
 (setq mylist '(("APPLE" "PEAR") ("STRAWBERRY" "BANANA")))
 (if (setq sset (ssget ":L" '((0 . "TEXT"))))
   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))
     (setq str (cdr (assoc 1 (setq el (entget e)))))
     (foreach item mylist
(if (vl-string-search (car item) str)
  (progn (while	(vl-string-search (car item) str)
	   (setq str (vl-string-subst (cadr item) (car item) str))
	 )
	 (entmod (subst (cons 1 str) (assoc 1 el) el))
  )
)
     )
   )
 )
 (command "cmdecho" "1")
 (command "_.undo" "end")
 (princ)
)

[Grrr]

This subfunction might be handy, but I'm unable to test it ATM:

 

; (_ReplaceWords 
; "APPLE IS MY FAVOURITE FRUIT BUT I HAVE ONLY STRAWBERRYS"
; '(("APPLE" "PEAR") ("STRAWBERRY" "BANANA"))
; )
(defun _ReplaceWords ( str aL )
 (mapcar     
   '(lambda (old new) (while (vl-string-search old str) (setq str (vl-string-subst new old str))))
   (mapcar 'car aL) (mapcar 'cadr aL)
 )
 str
); defun _ReplaceWords

[Zykl0]

Thank you very much guys this is working flawlessly!

[Roy_043]

Note:

(while (vl-string-search old str) ...)

is problematic if the new string contains the old string: '(("APPLE" "APPLES")).

 

Here is my suggestion:

; (String_Subst "aabbaacc" "aa" "xx")   => "xxbbxxcc"
; (String_Subst "aabbaacc" "aa" "xxaa") => "xxaabbxxaacc"
(defun String_Subst (str old new / idx)
 (setq idx 0)
 (while (setq idx (vl-string-search old str idx))
   (setq str (vl-string-subst new old str idx))
   (setq idx (+ idx (strlen new)))
 )
 str
)

[ronjonp]

Note:

(while (vl-string-search old str) ...)

is problematic if the new string contains the old string: '(("APPLE" "APPLES")).

 

Here is my suggestion:

; (String_Subst "aabbaacc" "aa" "xx")   => "xxbbxxcc"
; (String_Subst "aabbaacc" "aa" "xxaa") => "xxaabbxxaacc"
(defun String_Subst (str old new / idx)
 (setq idx 0)
 (while (setq idx (vl-string-search old str idx))
   (setq str (vl-string-subst new old str idx))
   (setq idx (+ idx (strlen new)))
 )
 str
)

 

Good call Roy

[Grrr]

Note:

(while (vl-string-search old str) ...)

is problematic if the new string contains the old string: '(("APPLE" "APPLES")).

 

Here is my suggestion:

...

 

Thanks Roy, I didn't think of that problem!