HELP : I need a LISP Routing That can help me find a specific text within multiple Mtext and change their color

[wahab]

 

I have multiple Mtext in a scehmatic Drawing , containing text 

 

The blue color in the this text box indicated planned state ,so once this particular link is commissioned i will be changing it to green

QDC(55-56)-LZS[192F](19-20) Reserved for Bu samdra WDM Connectivity

 

This specfic text is duplicating in aroung 20 to 30 M texts ,i want a routing that can automate this manual work

 

Any help would be greatly appreciated
 

 

 

 

Edited July 4, 2022 by wahab

[BIGAL]

If you look at this

The text string is "ABC{\\C1;DEF\\C3;ghi}\\P" so can see color string 

 

This is very rough and needs more error checking but as a 1st go, enter color number of existing mtext then new color. If it works doing manually then can add the multiple option. Really need a true dwg to check properly.

 

(defun c:mtextcol ( / obj strold strnew str1 str2 str3)
(setq obj (vlax-ename->vla-object (car  (entsel "Pick mtext"))))
(setq str (vla-get-textstring obj))
(setq strold (strcat "C" (getstring "\nEnter old color number ")))
(setq strnew (strcat "C" (getstring "\nEnter new color number ")))
(setq pos (vl-string-search  strold str))
(setq str1 (substr str 1 pos))
(setq str2 (substr str (+ pos 3)))
(setq str3 (strcat str1 strnew str2))
(vla-put-textstring obj str3)
(princ)
)

 

[wahab]

Thanks bigal ,

 

this lisp just changes the color of the entire mtext , which is easy enough .

my problem is to Find a certain Character string inside all the Mtexts in my drawing and the change their colors.

 

[Steven P]

So I reckon if you get some Mtext and entget the description of it, in the text (assoc code 1, 3 or whatever it is for that length of MTEXT) there will be something like {\\C5 ..... } c5 for blue text of course)

 

'All' you need to do is search through the MTEXTs for the relevant text strings, then in the MTEXT containing it look for the colour change code and alter that if that makes sense?

 

Might be you have to use something vl-str-position a couple of times to get the codes position, split the text, insert new code, strcat the parts back together and entupd?

 

 

[wahab]

Hi steven , iam not very adept to LISP code writing  but as i understand my requirement is not to look for the colour change postion ,instead i want to be  able to match a text that i input myself and then i want to be able to change it's color ,regardless of where it lies in the M text.

 

I usally use find and replace to change the content of the text all the time and then manually go to all the mexts and change the color of the text.

 

examply in the snapshot above ,

 

Reserved for madinata compound ,once this link is Ready for service i will find and replace this specific text to for example " NDIA_GPON1_1-1-1-8"  and for this specific text i want the color to be Green instead of blue .

 

i just want the default find and replace functionality which instead of replace the text can replace the color of the text.

[BIGAL]

Post a dwg with before and after.

[Steven P]

2 hours ago, wahab said:

Hi steven , iam not very adept to LISP code writing  but as i understand my requirement is not to look for the colour change postion ,instead i want to be  able to match a text that i input myself and then i want to be able to change it's color ,regardless of where it lies in the M text.

 

 

In the MText text itself are 'hidden' codes to control its formatting, you can see them if you select the text and look at it in the properties box, in the case of colour changes part way through the text there will be something like {\\C5. If you change the colour description or colour code whatever text in between the { brackets will change.

 

You could do a text replace in the mtext string and add this colour code into the string you replace if you want, have to do that by modifying the entity (entmod) I think otherwise it might see the colour code as text to be displayed.

 

 

I'll see if I can put something together later to show this

 

[Steven P]

So by way of example, if you have some mtext in your drawing, and then run txtreplace lisp below.

 

For old text to replace choose what you want "My Text"

In the second text, new text, put in the colour code:  {\c4;"My Text"} and this should change that part to colour code '4' (cyan)

 

See how that works, It isn't something I do so am not sure how well this works but for a quick test it worked just then. Note that if you have any dtext in the drawing with that text string in it, then it will show the colour code above on the screen

 

If this works OK can adjust the function txtreplace to make it easier for you, selecting only mtexts and a simple interface to ask for the colour code

 

 

;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-and-replace-text/td-p/5649883
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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
;-------------------------------------------------------------------------------
(defun FindReplaceAll (Find$ Replace$ / BlkEntList@ BlkEntName^ BlkEntType$ Cnt#
  DimEntList@ DimEntName^ DimEntType$ EntList@ EntName^ EntType$ FindReplace:
  Mid$ Mid2$ NewText$ Num# Replace$ SS& Text$ acount)
  ;-----------------------------------------------------------------------------
  ; 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
  ;-----------------------------------------------------------------------------


(setq acount 0)

  (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$))

(if (= ReplaceWith$ Text$)
    ()
    (setq acount (+ acount 1))
)
                  (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 "TXTREPLACE made ")
  (princ acount)
  (princ " changes. ")
  acount
);defun FindReplaceAll
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

 

[wahab]

I have added a portion of my drawing , i tried txt replace function and it didn't change any text in this drawing.

 

you can also try changing (Reserved for Madinata Compound) with (NDIA-GPON1-1-1-1) with a change of color to green \C92

 

i saw the contents and yes your right ,the formatting data is embedded in it.

TEST.dwg

[wahab]

Just an update , the test replace did work ,but not on all the mtext ,I just used the textreplacefunc in you LISP.

 

My in input was 

OLD text:DHL Splitter 1:32

New Text:asdasdsads Splitters

 

Ideally it should have changed all the texts

 

[Steven P]

Thanks for the test drawing and I can see the problem.... err thanks I think because the replace function needs a little reworking that I have never noticed before.

 

So in technical things, every object you draw is an entity and all the parameters for that are contained in an entity description - the entget I mentioned above refers to that. I think each entry into that definition can be about 250 characters long, not normally a problem with annotating a drawing., but with long mtext you get an overspill to another part of the entity description, and you need to pick that up too for the text replace. That's what needs doing in the function above, to add in these other codes so it looks at all the text.

 

Anyway, thanks, I was hoping for a nice easy answer "here, try this" and you come back with a simple "can you make it do that" and off you go happy..... but no, needs a bit more work...

 

 

On the positive side though, the shorter texts and I think it works as you want, you can set it to change text and change colours as you want

 

 

 

Right, so off I go see if I can think of a simple change - lunch here first though

[Steven P]

Got this mostly working now, copy and pasting other building blocks, just need to check it out fully - a useful exercise since it wasn't right

 

In the office tomorrow so have to work for a living.... will fiddle with this a bit more depends if the boss is in or not

[wahab]

Thanks steven , i really appreciate it .

 

It would be save me a lot of manual work .

 

 

[Steven P]

Try this, Colreplace

 

Had to rework some if this (well a fair bit) to make it work OK and built it up using bits and pieces I have.. but there is a chance that I haven't copied everything it needs below, hope not though.

 

It should work by searching just for mtext (so will ignore text, blocks, dimensions, leaders and all sorts of other text things). It worked - for me- on your test file.

 

(defun c:colreplace( / 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 colour code: "))
  (setq new_text (strcat "{\\C" new_text ";" old_text "}"))
  (ColReplace old_text new_text)
  (princ)
)
(defun ColReplace (Find$ Replace$ / acount acounter SS ent1 entlist1 entcodes1 text01 FoundReplaced NewTxt)
  (defun getfroment (ent listorstring entcodes / acount acounter mytext newtext stringtext)
    (setq entlist (entget ent))
    (setq acount 0)
    (while (< acount (length entlist))
      (setq acounter 0)
      (while (< acounter (length entcodes))
        (setq entcode (nth acounter entcodes))
        (if (= (car (nth acount entlist)) entcode )
          (progn
            (setq newtext (cdr (nth acount entlist)))
            (if (numberp newtext)(setq newtext (rtos newtext))) ;fix for real numbers
            (setq mytext (append mytext (list (cons (car (nth acount entlist)) newtext) )) )
          );end progn
        );end if
        (setq acounter (+ acounter 1))
      );end while
      (setq acount (+ acount 1))
    );end while
  ;;get string from dotted pair lists
    (if (= listorstring "astring") ;convert to text
      (progn
        (if (> (length mytext) 0)
            (progn
            (setq acount 0)
            (setq temptext "")
            (while (< acount (length mytext))
              (setq temptext (cdr (nth acount mytext)) )
              (if (= stringtext nil)
                (setq stringtext temptext)
                (setq stringtext (strcat stringtext temptext ))
              );end if
              (setq acount (+ acount 1))
            );end while
          );end progn
        );end if
        (if (= stringtext nil)(setq stringtext ""))
        (setq mytext stringtext)
      );end progn
    );end if
    mytext
  )
;;get text as a string
  (defun gettextasstring ( enta entcodes / texta )
    (if (= (getfroment enta "astring" entcodes) "")
      ()
      (setq texta (getfroment enta "astring" entcodes))
    )
    texta
  )
  (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 addinnewtext (newtext newentlist newent / )
    (if (/= newtext nil)
      (progn
        (if (= (cdr (assoc 0 newentlist)) "DIMENSION") 
          (progn
;;ent mod method, stops working at 2000-ish characters
            (entmod (setq newentlist (subst (cons 1 newtext) (assoc 1 newentlist) newentlist)))
            (entupd newent)
          );end progn
          (progn
;;vla-put-text string for large text blocks + 2000 characters?
            (vla-put-textstring (vlax-ename->vla-object newent) newtext)
          );end progn
        ) ;end if
      ) ;end progn
      (princ "\nSource text is not 'text'")
    );end if
  )


  (command "UNDO" "BEGIN")
  (setq acount 0)
  (setq acounter 0)
  (setq SS (ssget "x" (list '(0 . "MTEXT")))) ;CHANGES TEXT
  (while (< acounter (sslength SS))
    (setq ent1 (ssname SS acounter))
    (setq entlist1 (entget ent1))
    (setq entcodes1 (list 3 4 1 172 304) ) ;list of ent codes containing text.
    (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string
    (setq FoundReplaced (FindReplace text01 Find$ Replace$))
    (setq NewTxt (nth 0 FoundReplaced))
    (setq acount (+ acount (nth 1 FoundReplaced)))
    (addinnewtext NewTxt entlist1 ent1)
    (setq acounter (+ 1 acounter))
  ) ; end while

  (command "redraw")
  (command "regen") ;;update it all
  (command "UNDO" "END")

  (princ "\nTXTREPLACE made ")
  (princ acount)
  (princ " changes.")
  acount
)

 

[wahab]

I just checked it out ,ran some samples and it works like a charm so far .

 

thank you sooo much !!!!

 

 

[Steven P]

No problem,

 

Kind of glad I looked at this and kind of glad I didn't since it has thrown up some fixes I need to do on other LISPs.