The pound sign wobbles textreplacer

[bustr]

The text replacer lisp refuses to work when there is a # in the text string tobe replaced or the string to replace it. Does anyone know how to fix?

 

revised per #555188

revised per #666299

TXTREPLACE.LSP

Edited 4 hours ago by bustr

[pkenewell]

Why not just use the built-in FIND command in AutoCAD? You just have to turn off the "Use Wildcards" option.

[bustr]

24 minutes ago, pkenewell said:

Why not just use the built-in FIND command in AutoCAD? You just have to turn off the "Use Wildcards" option.

That works well if there is only one value that needs to be replaced. Thanks.

 

[Steven P]

2 hours ago, pkenewell said:

Why not just use the built-in FIND command in AutoCAD? You just have to turn off the "Use Wildcards" option.

 

 

For example I use a LISP find/replace if I don't want a dialogue box for example in a batch process.

 

[BIGAL]

I tried this as a test, so finds the #1234 text. It will find 123#456 also. But the lisp as suggested by @Steven P should cater for that.

 

(setq ss (ssget "X" (list (cons 0 "*text")(cons 1  "*#*"))))
(princ (sslength ss))

12

 

[Steven P]

 

 

 

This is what I use, I think the route LISP is the same as the OPs, over time I have added to it:

 

txtfindreplace

 

;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-and-replace-text/td-p/5649883
(defun FindReplace (Str$ Find$ Replace$ / Cnt# FindLen# Loop Mid$ NewStr$ ReplaceLen# acount)
    (setq Loop t
          Cnt# 1
          NewStr$ Str$
          FindLen# (strlen Find$)
          ReplaceLen# (strlen Replace$)
    )
    (setq acount 0)
    (while Loop
      (setq Mid$ (substr NewStr$ Cnt# FindLen#))
      (if (= Mid$ Find$)
        (progn
          (setq acount (+ acount 1))
          (setq NewStr$ (strcat (substr NewStr$ 1 (1- Cnt#)) Replace$ (substr NewStr$ (+ Cnt# FindLen#)))
                Cnt# (+ Cnt# ReplaceLen#)
          );setq
        );end progn
        (setq Cnt# (1+ Cnt#))
      );if
      (if (= Mid$ "") (setq Loop nil))
    );while
    (list NewStr$ acount)
);defun FindReplace


(defun FindReplaceNew (Find$ Replace$ / SS acounter acount ent1 entlist1 entcodes1 EntType Text$ text01 ReplaceWith$ FoundReplaced NewTxt MyBlockEntList BlockCounter )
;;;Sub Routines ;;;;
;;;;;;;;;;;;;;;;;;;;
;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-entities-inside-a-block/td-p/2644829
  (defun getblkitems ( EntName / sel items) ;;Blocks:
    (setq nfo (entget EntName))
    (progn
      (vlax-for item (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object) ) )
                     (cdr (assoc 2 nfo)) )
                    (setq items (cons (vlax-vla-object->ename item) items))
      ) ;end vlax
    ) ; end progn
  ) ;end defun
  (defun updateblock ( EntType ent1 entlist1 acount Find$ Replace$ / MyBlockEntList BlockCounter EntType2 ent2 entlist2 )
    (if (= EntType "INSERT")
      (progn
;;Updates block texts & block blocks
        (setq MyBlockEntList (getblkitems ent1) )
        (setq BlockCounter 0)
        (while (< BlockCounter (length MyBlockEntList))
          (setq ent2 (nth BlockCounter MyBlockEntList))
          (setq entlist2 (entget ent2))
          (setq EntType2 (cdr (assoc 0 entlist2)) )
;;Attrributes
          (setq acount (updateattribvalues EntType ent1 entlist1 acount Find$ Replace$))
;;Texts
          (if (or (= EntType2 "TEXT")(= EntType2 "MTEXT")(= EntType2 "MULTILEADER")) ;;attributes?
            (setq acount (updatetext EntType2 ent2 entlist2 acount Find$ Replace$))
          ); end if
;;Changes Dimensions
          (if (or (= EntType2 "DIMENSION") )
            (if (= (cdr (assoc 1 entlist2)) "") ;;if has text over ride
              ()
              (progn
                (setq acount (updatetext EntType2 ent2 entlist2 acount Find$ Replace$)) ;;same as text -if- ent code 4 used
                (command ".-refedit" (cdr (assoc 10 entlist1)) "ok" "all" "yes") ;;update block definition
                (command "refclose" "s")
              );end progn
            ) ;end if
          ); end if
          (if (= EntType2 "ACAD_TABLE")
            (setq acount (UpdateTable EntType2 ent2 entlist2 acount Find$ Replace$))
          );end if
          (if (= EntType2 "INSERT") ;;Blocks
            (setq acount (updateblock EntType2 ent2 entlist2 acount Find$ Replace$))
          );end if
          (setq BlockCounter (+ BlockCounter 1))
        ) ; end while
      );end progn
    );end if

    acount
  )
;;End Blocks
;;;;;;;;;;;;;;;;;;;;
  (defun updateattribvalues (EntType ent1 entlist1 acount Find$ Replace$ / )
    (setq EntName^ ent1
          EntList@ entlist1
          EntType$ EntType
          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 FoundReplaced (FindReplace Text$ Find$ Replace$))
                    (setq ReplaceWith$ (nth 0 FoundReplaced))
                    (setq acount (+ acount (nth 1 FoundReplaced)))
                    (entmod (subst (cons 1 ReplaceWith$) (assoc 1 EntList@) EntList@))
                    (entupd EntName^)
                  );progn
                );if
              );progn
            );end if attrib
            (setq EntName^ (entnext EntName^))
          );while
        );progn
      );if
    );if
    acount
  ) ;end defun
;;;;;;;;;;;;;;;;;;;;
  (defun updatetext (EntType ent1 entlist1 acount Find$ Replace$ / entcodes1 FoundReplaced NewTxt)
    (progn
      (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text.
      (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string
        (if (= text01 nil)
          ()
          (progn
            (setq FoundReplaced (FindReplace text01 Find$ Replace$))
            (setq NewTxt (nth 0 FoundReplaced))
            (setq acount (+ acount (nth 1 FoundReplaced)))
            (addinnewtext NewTxt entlist1 ent1)
        )) ;end progn, end if
      ) ; end progn
    acount
  )
;;;;;;;;;;;;;;;;;;;;
  (defun UpdateTable ( EntType ent1 entlist1 acount Find$ Replace$ / text01 Newentlist1 counter)
    (setq counter 0)
    (setq Newentlist1 '())
    (while (< counter (length entlist1))
      (if (or (= (nth 0 (nth counter entlist1)) 1)(= (nth 0 (nth counter entlist1)) 302) )
        (progn
          (setq text01 (cdr (nth counter entlist1)))
          (setq FoundReplaced (FindReplace text01 Find$ Replace$))
          (setq NewTxt (nth 0 FoundReplaced))
          (setq acount (+ acount (nth 1 FoundReplaced)))
          (setq text01 NewTxt)
          (setq Newentlist1 (append Newentlist1 (list (cons (nth 0 (nth counter entlist1)) text01))))
        ) ;end progn
        (setq Newentlist1 (append Newentlist1 (list (nth counter entlist1)))) ;;ignore entity item
      ) ;end if
      (setq counter (+ counter 1))
    ) ;end while
    (setq entlist1 Newentlist1)
    (entmod entlist1)
    (entupd ent1)
    acount
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;end subroutines 'findreplace'
  (setq acount 0)
  (setq acounter 0)
  (command "UNDO" "BEGIN")

  (setq SS (ssget "x" (list 
    '(-4 . "<AND")
      '(-4 . "<OR")
        '(0 . "*TEXT")
        '(0 . "INSERT")
        '(0 . "ATTDEF")
        '(0 . "ATTRIB")
        '(0 . "DIMENSION")
        '(0 . "*LEADER")
        '(0 . "POSITIONMARKER")
        '(0 . "*TABLE")
      '(-4 . "OR>")
      (cons 410 (getvar "CTAB"))
    '(-4 . "AND>")
  ))) ; end setq, end ss, end list


;;;FILTER SS to text string


  (while (< acounter (sslength SS))
    (setq ent1 (ssname SS acounter))
    (setq entlist1 (entget ent1))
    (setq EntType (cdr (assoc 0 entlist1)) )
    (setq Text$ (cdr (assoc 1 entlist1)) )  ;;change this line to get all texts inc. long texts etc.

;;Changes Attribute Values - In Blocks
  (setq acount (updateattribvalues EntType ent1 entlist1 acount Find$ Replace$))

;;Changes Block Texts
  (if (= EntType "INSERT")
    (setq acount (updateblock EntType ent1 entlist1 acount Find$ Replace$))
  );end if

;;Changes Texts
  (if (or (= EntType "MTEXT")(= EntType "TEXT")
          (= EntType "MULTILEADER")
          (= EntType "POSITIONMARKER")
      )
    (setq acount (updatetext EntType ent1 entlist1 acount Find$ Replace$))
  ); end if

  (if (or (= EntType "DIMENSION") )
    (if (= (cdr (assoc 1 entlist1)) "") ;;if has text over ride
      ()
      (setq acount (updatetext EntType ent1 entlist1 acount Find$ Replace$)) ;;same as text -if- ent code 4 used
    )
  ); end if

  (if (or (= EntType "ATTDEF")(= EntType "ATTRIB") )
    (progn
      (setq ent2 (entget ent1))
      (setq AttText (cdr (assoc 2 ent2)))
      (setq FoundReplaced (FindReplace AttText Find$ Replace$))
      (setq NewTxt (nth 0 FoundReplaced))
      (setq acount (+ acount (nth 1 FoundReplaced)))
      (setq newval Replace$)
      (entmod (subst (cons 2 NewTxt) (assoc 2 ent2) ent2))
      (entupd ent1)
    );end progn
  ); end if

  (if (= EntType "ACAD_TABLE")
    (setq acount (UpdateTable EntType ent1 entlist1 acount Find$ Replace$))
  );end if

    (setq acounter (+ 1 acounter))
  ) ; end while

  (command "REGEN")
  (command "UNDO" "END")
  acount
);defun FindReplaceNew



(defun c:txtFindReplace( / 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: "))
  (princ "Changes: ")
  (princ   (FindReplaceNew old_text new_text) )
  (princ)
)

 

Edited 1 hour ago by Steven P