HELP:LISP to change color of text base on certain words including within nested block

Did a search but fail to find one.

Basically i have certain words in a mixture of text & mtext as well as inside blocks & nested blocks that I need to chane to a different color depending on which words.

Would be great if the process is as such

1) run lisp

2) key in the words (no need whole words or case sensitive)

3) key in the color number

3) select the area of search (this includes deep nested blocks)

currently i go into every block to use the FIND command to change & it is tedious

Thanks

Did a search but fail to find one.

 

Basically i have certain words in a mixture of text & mtext as well as inside blocks & nested blocks that I need to chane to a different color depending on which words.

 

Would be great if the process is as such

 

1) run lisp

2) key in the words (no need whole words or case sensitive)

3) key in the color number

3) select the area of search (this includes deep nested blocks)

 

currently i go into every block to use the FIND command to change & it is tedious

 

Thanks

Hi buddy, sorry but this is only I can offer, im still a newbie, but anyway it works.

Noob macro below.

(setq BLK "?") 
(defun c:test ()
(setvar "cmdecho" 1)
(setq cBLK (getstring (strcat "\nEnter block name of text <" BLK ">: ")))
(if (= cBLK "")
    (setq cstr BLK)
    (setq BLK cBLK)
)
(command "-bedit" BLK "")
(command "zoom" "1000" "")
(c:OTA)
(princ)
)
(setq str "?") 
(defun C:OTA(/ cntr eset en enlist pt clr)
(setvar "cmdecho" 1)
(setq cstr (getstring (strcat "\nEnter text string <" str ">: ")))
(if (= cstr "")
    (setq cstr str)
    (setq str cstr)
)
 (defun FilterTxtValuX(eset valu)
   (setq cntr 0 newSet(ssadd))
   (while(< cntr (sslength eset))
     (setq en(ssname eset cntr))
     (setq enlist(entget en))
     (if(= (strcase valu) (strcase (cdr(assoc 1 enlist))))
       (ssadd en newSet)
     )
     (setq cntr(+ cntr 1))
   )
   newSet
 )
 (setvar "cmdecho" 0)
 (setq clr(acad_colordlg 1 nil))
 (setq eset
   (ssget"X" 
     (list 
       (cons -4 "<OR")
         (cons 0 "MTEXT")
         (cons 0 "TEXT")
       (cons -4 "OR>")
     )
   )
 ) 
 (if(and eset(> (sslength eset) 0))(setq eset(FilterTxtValuX eset str)))
 (if (and eset (> (sslength eset) 0))
   (progn
     (command "change" eset "" "Properties" "Color" clr "")
   )
 )
 (setvar "cmdecho" 1)
 (command "bclose" "")
 (command "zoom" "e")
 (princ)
)
(princ "\n Type test.")
(princ)

how it works.

Enter the name of the block of where the text resides.

Enter the text string (will ony work on words & strings without spaces)

Enter color number.

greetings from

Phils.

Hi Bro, many thanks for the effort.

Have tried it out & it works as per your instructions.

I do need something speedy that I can just window to select the following (without needing the block names) for the changes:-

1) standalone text, mtext,

2) blocks (with text inside these blocks)

3) nested blocks (text inside the block within these blocks)

Appreciate your effort

Give this a go and let me know .

(defun c:Test (/ _doc c ss i sn name lst st)
;;;                Tharwat 22.01.2015                        ;;;
 (defun _change:color:in:block (e c st / o e)
;;;                                                 ;;;
;;;    Variables :                                    ;;;
;;;    e = Block Definition ( "INSERT" )                    ;;;
;;;    c = Color to replace color of objects in blocks            ;;;
;;;    st = Text string to be searched for to be colored           ;;;
;;; ___________________________________________________________    ;;;
   (setq e (tblobjname "BLOCK" (cdr (assoc 2 (entget e)))))
   (while (setq e (entnext e))
     (cond
       ((and (eq (cdr (assoc 0 (setq o (entget e)))) "INSERT")
             (not (member '(66 . 1) o))
             (not (member (cdr (assoc 2 o)) lst))
        )
        (progn
          (setq lst (cons (cdr (assoc 2 o)) lst))
          (_change:color:in:block e c st)
        )
       )
       ((and (wcmatch (cdr (assoc 0 o)) "*TEXT")
             (eq (cdr (assoc 1 o)) st)
        )
        (entmod (append o (list (cons 62 c))))
       )
     )
   )
 )
 (if
   (and (/= ""
            (setq st (getstring t "\n Specify the Text string to color :"))
        )
        (setq c (acad_colordlg )
        (setq ss (ssget "_:L"
                        (list '(-4 . "<OR")
                              '(0 . "INSERT")
                              '(-4 . "<AND")
                              '(0 . "TEXT,MTEXT")
                              (cons 1 st)
                              '(-4 . "AND>")
                              '(-4 . "OR>")
                        )
                 )
        )
   )
    (progn
      (vla-startundomark
        (setq _doc (vla-get-activedocument (vlax-get-acad-object)))
      )
      (repeat (setq i (sslength ss))
        (if
          (wcmatch
            (cdr
              (assoc 0 (entget (setq sn (ssname ss (setq i (1- i))))))
            )
            "*TEXT"
          )
           (if (eq (cdr (assoc 1 (entget sn))) st)
             (entmod (append (entget sn) (list (cons 62 c))))
           )
           (if (not (member (setq name
                                   (cdr
                                     (assoc
                                       2
                                       (entget
                                         sn
                                       )
                                     )
                                   )
                            )
                            lst
                    )
               )
             (progn
               (setq lst (cons name lst))
               (_change:color:in:block sn c st)
             )
           )
        )
      )
      (vla-endundomark _doc)
      (vla-regen _doc acallviewports)
    )
 )
 (princ)
)(vl-load-com)

WOW Tharwat.

It works almost perfect bro.

Could normal text & mtext ...etc that is not blocked be included in this lisp package to be colored as well? Currently those standalone text did not change & is also unselectable. Only blocks can be selected.

Thanks alot

I dont belive you can do multi colour words in standard text you can in mtext so 1st step may be to convert to mtext then insert colour codes.

This is image TextString = "{\\fArial|b0|i0|c0|p34;HEADING \\C1;asdf\\C256; \\C3;ghh\\C256; jjjj}"

It may be as simple as modify the text string asdf now \\C1;asdf\\c256 Found VL-string-subst now to find time for code

this is close but I have discovered a problem I need to remove the preceeding colour switch from the text.

(setq Col (getint "\nEnter colour num"))
(setq str (getstring "\nEnterstring"))  
(setq obj (vlax-ename->vla-object (car (entsel))))
(setq extext (vla-get-textstring obj))
(setq newstr (strcat "[url="file://\\c"]\\c[/url]" (rtos col 2 0) ";" str ))
(setq newtext (vl-string-subst newstr str extext))
(vla-put-textstring newtext obj)

Hi BIGAL,

Just to clarify, i am changing color only for whole words currently.

However your concept of changing colour for individual words in a string of sentences is interesting & may be useful in the future. Looking forward to your creations.

I just need color change for whole words at the moment.

If you want to only change the whole line ie all words CHprop will work or just entmod the dxf code 62.

I have since like below worked out the correct way to do colour for 1 word.

(setq obj (vlax-ename->vla-object (car (entsel)))) ; pick mtext
(vla-put-textstring obj "{\\fArial|b0|i0|c0|p34;\\C32;HEADING\\C256; assdff jkfhkjh jnfkj  }" )

BIGAL Errr.... how to run that command? I guess "CAR" is the word to change the color?

Also, just wanted to run a single command that changes text & text within blocks & nested blocks.

WOW Tharwat.

 

It works almost perfect bro.

 

Could normal text & mtext ...etc that is not blocked be included in this lisp package to be colored as well? Currently those standalone text did not change & is also unselectable. Only blocks can be selected.

 

Thanks alot

I modified the program to include (m)texts .

Hi Tharwat.

Tested.

The text within block is ok. But for text outside block, every words selected had their color changed.

That's odd ,

Upload a sample drawing and what is the text string that you type when the program asks you to enter .

test color change text.dwg

Hi Tharwat.

Attached is a sample.

I have my explaination inside the drawing.

Thanks

I have updated the program and added some extra improvements

Hi Tharwat.

Hi Tharwat.

 

 

 

 

Haha ... Happy to help

Hi Tharwat.

Would you be able to modify the lisp such that it will highlight the text as long as it has a particular word?

Thanks

Would you be able to modify the lisp such that it will highlight the text as long as it has a particular word?

As far I can tell , you can not highlight texts in Blocks but for texts objects , it is possible .

As far I can tell , you can not highlight texts in Blocks but for texts objects , it is possible .

Not quite sure what you meant but perhaps I can clarify further.

As what your lisp routine can do is to color the selected text (including text in blocks) base on keying in of full whole words.

EXAMPLE: Drawing has DOOR A, DOOR B, DOOR C & WINDOW A

Current lisp routine

if "DOOR A" is keyed in, all "DOOR A" will be selected to change color.

If possible can the routine select base on a wildcard word instead, as such:-

Modified lisp routine

if "DOOR" is keyed in, all "DOOR A", "DOOR B" & "DOOR C" will be selected to change color (Only WINDOW A is not selected)

if "A" is keyed in, all "DOOR A" & "WINDOW A" will be selected to change color (Only DOOR B & DOOR C are not selected)

Thanks

This ?

(defun c:Test  (/ _doc c ss i sn name lst st)
;;;                Tharwat 27.01.2015                            ;;;
 (defun _change:color:in:block  (e c st / o e)
;;; ___________________________________________________________    ;;;
;;;    Variables :                                            ;;;
;;;    e = Block Definition ( "INSERT" )                        ;;;
;;;    c = Color to replace color of objects in blocks            ;;;
;;;    st = Text string to be searched for to be colored         ;;;
;;; ___________________________________________________________    ;;;
   (setq e (tblobjname "BLOCK" (cdr (assoc 2 (entget e)))))
   (while (setq e (entnext e))
     (cond
       ((and (eq (cdr (assoc 0 (setq o (entget e)))) "INSERT")
             (not (member '(66 . 1) o))
             (not (member (cdr (assoc 2 o)) lst))
             )
        (progn
          (setq lst (cons (cdr (assoc 2 o)) lst))
          (_change:color:in:block e c st)
          )
        )
       ((and (wcmatch (cdr (assoc 0 o)) "*TEXT")
             (wcmatch (cdr (assoc 1 o)) (strcat st "*"))
             )
        (entmod (append o (list (cons 62 c))))
        )
       )
     )
   )
 (if
   (and (/= ""
            (setq st
                   (getstring t "\n Specify the Text string to color :"))
            )
        (setq c (acad_colordlg )
        (setq ss (ssget "_:L"
                        (list '(-4 . "<OR")
                              '(0 . "INSERT")
                              '(-4 . "<AND")
                              '(0 . "TEXT,MTEXT")
                              (cons 1 (strcat st "*"))
                              '(-4 . "AND>")
                              '(-4 . "OR>")
                              )
                        )
              )
        )
    (progn
      (vla-startundomark
        (setq _doc (vla-get-activedocument (vlax-get-acad-object)))
        )
      (repeat (setq i (sslength ss))
        (if
          (wcmatch
            (cdr
              (assoc
                0
                (entget (setq sn (ssname ss (setq i (1- i))))))
              )
            "*TEXT"
            )
           (if
             (wcmatch (cdr (assoc 1 (entget sn))) (strcat st "*"))
              (entmod (append (entget sn) (list (cons 62 c))))
              )
           (if (not (member (setq name
                                   (cdr
                                     (assoc
                                       2
                                       (entget
                                         sn
                                         )
                                       )
                                     )
                                  )
                            lst
                            )
                    )
             (progn
               (setq lst (cons name lst))
               (_change:color:in:block sn c st)
               )
             )
           )
        )
      (vla-endundomark _doc)
      (vla-regen _doc acallviewports)
      )
    )
 (princ)
 )(vl-load-com)