Change Color of Words In Mtext Using Wildcards

[DGCSCAD]

Hi all,

I found something similar: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/change-specific-word-color/td-p/5513...

...but I need to find all words wrapped in parenthesis and change color to blue.

Example:

Original - This is a (test) string.

Change - This is a (test) string.

Tried modifying the Str variable with a wildcard pattern, but thats not the right approach.

(setq Str "('*)")

I'm thinking I may need to use wcmatch, but I'm having a bit of trouble figuring this out.

Any nudge in the right direction is appreciated.

[Sea-Haven]

Look what I found just did a Google using a more appropriate search, change color word mtext autocad lisp

Solved: Change specific word color - Autodesk Community - AutoCAD

[komondormrex]

hey there,

could be one of the approaches.

convert the mtext string to a list of substrings. the delimiter will be space. find every substring in the list that starts and ends with paren and change it to conform to the blue color. strcat the whole string for mtext of the list of substrings and put it back to mtext. 

[DGCSCAD]

@Sea-Haven 

Thank you for the nudge. I did see that. I didn't see any use of wildcards, but maybe changing this portion to suit would be the way to go:

	  (setq	old_list (mapcar 'vl-princ-to-string '(330 331 332));<--change old numbers to suit
		new_list (mapcar 'vl-princ-to-string '(336 337 338));<--change new number to suit
		)

@komondormrex 

Thank you. I like that approach. I'll see if I can get something working. 

[DGCSCAD]

This is close, but there's something I'm not understanding about the wcmatch wildcards. It omits any instance where there are characters after the closing parenthesis, as in a period "." or formatting "\\".

(defun c:txt2blue (/ vlaobj txt txtlst txtlstfnd lst_ele1 lst_ele2 newstr txtlst newtxt)
(setq vlaobj (vlax-ename->vla-object (car  (entsel "Pick mtext\n"))))
(setq txt (vla-get-textstring vlaobj))
(setq txtlst (LM:str->lst txt " "))
(setq txtlstfnd (para_find "(*)" txtlst))
	(if (/= txtlstfnd nil)
		(progn
			(foreach n txtlstfnd
				(setq lst_ele1 (car n))
				(setq lst_ele2 (cdr n))
				(setq newstr (strcat "{\\C5;" lst_ele1 "}"))
				(setq txtlst (LM:SubstNth newstr lst_ele2 txtlst))
				(setq newtxt (LM:lst->str txtlst " "))
			)
		)
	)
(vla-put-textstring vlaobj newtxt)
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;SUB FUNCTIONS;;;;;;;;;;;;;;;;;;;;;;;;;;

;;---------------------=={ Subst Nth }==----------------------;;
;;                                                            ;;
;;  Substitutes an item at the nth position in a list.        ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  a - item to substitute                                    ;;
;;  n - position in list to make the substitution             ;;
;;  l - list in which to make the substitution                ;;
;;------------------------------------------------------------;;
;;  Returns:  Resultant list following the substitution       ;;
;;------------------------------------------------------------;;
(defun LM:SubstNth ( a n l / i )
    (setq i -1)
    (mapcar '(lambda ( x ) (if (= (setq i (1+ i)) n) a x)) l)
)

;Code by ronjonp (function name changed)
(defun para_find (m l / n)
  (setq n -1)
  (vl-remove 'nil (mapcar '(lambda (x) (setq n (1+ n)) (if (wcmatch x m) (cons x n))) l))
)

;; String to List  -  Lee Mac
;; Separates a string using a given delimiter
;; str - [str] String to process
;; del - [str] Delimiter by which to separate the string
;; Returns: [lst] List of strings
(defun LM:str->lst ( str del / len lst pos )
    (setq len (1+ (strlen del)))
    (while (setq pos (vl-string-search del str))
        (setq lst (cons (substr str 1 pos) lst)
              str (substr str (+ pos len))
        )
    )
    (reverse (cons str lst))
)

;; List to String  -  Lee Mac
;; Concatenates each string in a supplied list, separated by a given delimiter
;; lst - [lst] List of strings to concatenate
;; del - [str] Delimiter string to separate each item
(defun LM:lst->str ( lst del )
    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
)

[komondormrex · Accepted solution]

another one using et. for paired parens only.

(defun c:paren_mtext_blue (/ mtext mtext_string sub_limit_list open_paren_list parened_substring_list subst_start_pos_list subst_pos mtext_string)  
	(setq mtext (car (entsel "\Pick mtext: "))
	       mtext_string (vla-get-textstring (vlax-ename->vla-object mtext))
	       sub_limit_list (mapcar 'cons (setq open_paren_list (acet-str-m-find "(" mtext_string)) (acet-str-m-find ")" mtext_string)) 
	       parened_substring_list (mapcar '(lambda (sub_limit) (substr mtext_string (car sub_limit) (- (cdr sub_limit) (car sub_limit) -1))) 
	               				sub_limit_list
	               			)
	      subst_start_pos_list (append (list (car open_paren_list)) (mapcar '(lambda (pos) (+ (* (1+ (vl-position pos (cdr open_paren_list))) 5) pos)) (cdr open_paren_list)))
	      subst_pos -1
	 )
	 (foreach substring parened_substring_list
	  (setq mtext_string (vl-string-subst (strcat "{\\C5;" substring "}") substring mtext_string (1- (nth (setq subst_pos (1+ subst_pos)) subst_start_pos_list))))
	 )
	 (vla-put-textstring (vlax-ename->vla-object mtext) mtext_string)
)

[DGCSCAD]

@komondormrex 

Well, you can lead a horse to water, or you can hand him a glass of water...

lol

That works great! Thank you!

I had forgotten about the ET functions. I need to study this, but how would I make this also work for only changing all instances of (SUB1) (SUB2) etc.?

Ex:

String: "Change this (SUB1) and (SUB2)"

Result: "Change this (SUB1) and (SUB2)"

[komondormrex]

as a function. calling (paren_mtext_green '("(SUB1)" "(SUB2)")).

(defun paren_mtext_green (list_to_go / mtext mtext_string sub_limit_list open_paren_list parened_substring_list subst_start_pos_list subst_pos mtext_string)  
	(setq mtext (car (entsel "\Pick mtext: "))
	       mtext_string (vla-get-textstring (vlax-ename->vla-object mtext))
	       sub_limit_list (mapcar 'cons (setq open_paren_list (acet-str-m-find "(" mtext_string)) (acet-str-m-find ")" mtext_string)) 
	       parened_substring_list (mapcar '(lambda (sub_limit) (substr mtext_string (car sub_limit) (- (cdr sub_limit) (car sub_limit) -1))) 
	               				sub_limit_list
	               			)
	      subst_start_pos_list (append (list (car open_paren_list)) (mapcar '(lambda (pos) (+ (* (1+ (vl-position pos (cdr open_paren_list))) 5) pos)) (cdr open_paren_list)))
	      subst_pos -1
	 )
	 (foreach substring parened_substring_list
	   (if (member substring list_to_go) 
		  (setq mtext_string (vl-string-subst (strcat "{\\C3;" substring "}") substring mtext_string (1- (nth (setq subst_pos (1+ subst_pos)) subst_start_pos_list))))
	   )
	 )
	 (vla-put-textstring (vlax-ename->vla-object mtext) mtext_string)
)

[DGCSCAD]

@komondormrex 

Thank you! Any chance of this accepting wildcards in between the parenthesis?

[komondormrex · Accepted solution]

depends on your exact needs. brute approach is to pass wildcards.

(defun paren_mtext_green (wild_to_go / mtext mtext_string sub_limit_list open_paren_list parened_substring_list subst_start_pos_list subst_pos mtext_string)  
	(setq mtext (car (entsel "\Pick mtext: "))
	       mtext_string (vla-get-textstring (vlax-ename->vla-object mtext))
	       sub_limit_list (mapcar 'cons (setq open_paren_list (acet-str-m-find "(" mtext_string)) (acet-str-m-find ")" mtext_string)) 
	       parened_substring_list (mapcar '(lambda (sub_limit) (substr mtext_string (car sub_limit) (- (cdr sub_limit) (car sub_limit) -1))) 
	               				sub_limit_list
	               			)
	      subst_start_pos_list (append (list (car open_paren_list)) (mapcar '(lambda (pos) (+ (* (1+ (vl-position pos (cdr open_paren_list))) 5) pos)) (cdr open_paren_list)))
	      subst_pos -1
	 )
	 (foreach substring parened_substring_list
	   	(foreach wild wild_to_go
	   		(if (wcmatch substring wild) 
	   			  (setq mtext_string (vl-string-subst (strcat "{\\C3;" substring "}") substring mtext_string (1- (nth (setq subst_pos (1+ subst_pos)) subst_start_pos_list))))
	   		)
	   	)
	 )
	 (vla-put-textstring (vlax-ename->vla-object mtext) mtext_string)
	 (princ)
)

(paren_mtext_green '("*SUB#*")) will green up (SUB1), (SUB2)...

[DGCSCAD]

@komondormrex 

Thank you so much! I understand mapcar, just need to familiarize myself with lambda.

[komondormrex]

you are welcome)

[DGCSCAD]

This works great as intended, but I have another scenario:

I need to match SUB# with no parenthesis as well.

Is this possible with the way this works? It's not very apparent to me with the use of the acet-str-m-find looking for a ( and  a ). I'm thinking changing those to SUB and #, but not sure how to use wildcards in this.

[komondormrex]

you mean you want to colorize both "(SUB1...)" and "SUB1..." submtexts?

you can't use # wildcard in acet-str-m-find.

[komondormrex · Accepted solution]

but you can use another one from et with regular expressions.

(defun c:submtext_colorize (/ mtext mtext_string)
	(setq mtext (car (entsel "\Pick mtext: "))
		  mtext_string (vla-get-textstring (vlax-ename->vla-object mtext))
		  sub_color (getint "\nEnter color for submtext: ")
	)
	(vla-put-textstring (vlax-ename->vla-object mtext) 
						(acet-str-replace "\\((*sub+[0-9]+)*\\)" 
										 (strcat "{\\C" (itoa sub_color) ";\\1}") 
										 mtext_string t t
						)
	)
)

will colorize every instance of "sub1..." and "(sub2...)" in picked mtext to index color set. case insensitive.  

[DGCSCAD]

---

@komondormrex wrote:

but you can use another one from et with regular expressions.

(defun c:submtext_colorize (/ mtext mtext_string)
	(setq mtext (car (entsel "\Pick mtext: "))
		  mtext_string (vla-get-textstring (vlax-ename->vla-object mtext))
		  sub_color (getint "\nEnter color for submtext: ")
	)
	(vla-put-textstring (vlax-ename->vla-object mtext) 
						(acet-str-replace "\\((*sub+[0-9]+)*\\)" 
										 (strcat "{\\C" (itoa sub_color) ";\\1}") 
										 mtext_string t t
						)
	)
)

will colorize every instance of "sub1..." and "(sub2...)" in picked mtext to index color set. case insensitive.  

---

I appreciate that komondormrex. I threw something together that hard codes SUB's 1-9:

i.e.

(setq newtxt (acet-str-replace "SUB1" "{\\C3;SUB1}" newtxt T T))

...but your way is the proper way to do it. It helps me learn as well, which is also very much appreciated.