Arrange MText by colour

[Sambuddy]

Could someone let me know how to use put-string to arrange text by colour so that example: all content in colour #2 remain but contents in colour # 0 and #4 are removed without changing any of the text format or style?

I looked up Wmatch but it seems I cannot get anywhere with that.

(setq txt(vla-get-TextString(vlax-ename->vla-object (car (entsel)))))

 

(vla-put-textstring obj ...)

not quite sure how to deal with :  "\\pxse1.01;{\\C2;TEXT1\\PTEST2\\PTEST3}\\P{\\C4;TEST4\\PTEST5\\PTEST6}" to separate specific colours and merge them.

 

I am also thinking if I could ask which colour to remain, then any other colour could just be removed - this way not complication would arise from conditioning the colour numbers.

it could simply be Colour #0 + any colour stored on "Colnum" variable to stay.

(setq Colnum (getint "\nWhich Colour to Stay"))

Any ideas?

sample.dwg

Edited January 6, 2020 by Sambuddy
added content

[BIGAL]

(vl-string-search "\\C4" txt) =53

(vl-string-search "\\C2" txt) = 11 

 

So needs loops that removes "{\\Cx;" from string. Until not found. A (strcat subst + subst) maybe a lambda function something I am not good at.

 

Oh must find ending } also and remove. (vl-string-search pattern str [start-pos])So use start-pos as say 53+4 

(vl-string-search "}" txt 57) = 84

 

If using say 1st 7 colours something like this.

 

[Sambuddy]

@BIGAL 

I am not familiar with VLAX that much. The scramble does work though for me - Thank you AGAIN for your help.

 

Now the next step would be to bring in your radio button DCL and make it pretty. Also not quite sure to say remove (4) Cyan context while change (2) yellow to (0) white.

Could you please show me how?

 

(defun c:test (/ St1 Con1 Txt1)
	(if (and
		(setq Str1 (car (entsel "\nPick mtext: ")))
		(= "MTEXT" (cdr (assoc 0 (entget Str1))))
		(setq Con1 (vlax-ename->vla-object Str1))
      	    ) ;end and
    			(progn
			  (setq Txt1 (vla-get-textstring Con1))
      	   		  (while (vl-string-search "\\C2;" Txt1) (setq Txt1 (vl-string-subst "\\C0;" "\\C2;" Txt1))) ;change (#2) Yellow to (#0) BYBLOCK
           		  (vla-put-textstring Con1 Txt1)
    			) ;end progn
  	) ;end if
  (princ)
) ;end defun

Thanks

at one point I am going to implement your radio DCL but could you le me know how to remove certain colours with VLAX please?

Edited January 7, 2020 by Sambuddy

[Sambuddy]

Of course below is not working but I would like to say everything in colour #30 context or characters to be removed.

(while (vl-string-search "\\C30;" Txt1) (setq Txt1 (vl-remove "\\C30;" Txt1))) ;Delete (#30) Orange

any help please?

[pkenewell]

Perhaps this (for ANY formatted color within the string) altering your previous code? Added a prompt to enter the ACI color number you wish to remove.

 

NOTE: If I interpreted you correctly - did you want to remove both the format and the part of the string that was in that color? That is what i did with this code. If that is NOT what you meant - let me know. The solution is simpler and closer to your original code.

 

(defun c:test (/ doc idx St1 strcol Con1 Txt1)
   (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
	(if (and
		  (setq Str1 (car (entsel "\nPick mtext: ")))
          (setq strcol (getstring "\nEnter ACI color number to remove: "))
		  (= "MTEXT" (cdr (assoc 0 (entget Str1))))
		  (setq Con1 (vlax-ename->vla-object Str1))
       ) ;end and
    	 (progn
		    (setq Txt1 (vla-get-textstring Con1) strcol (strcat "\\C" strcol ";"))
      	    (while (setq idx (vl-string-search strcol Txt1))
             (setq txt1
                (strcat
                   (vl-string-right-trim "{" (substr txt1 1 idx))
                   (vl-string-left-trim "}\\P" (substr txt1 (1+ (vl-string-search "}" txt1 idx))))
                )
             )
          ) ;Remove anything in the string up to the next closing brace "}"
          (vla-put-textstring Con1 Txt1)
    	 ) ;end progn
  	) ;end if
   (vla-endundomark doc)
  (princ)
) ;end defun

Also Note: If you want to change the color selection to BIGAL's DCL function. Just replace the (getstring..) statement within the (setq strcol ... to the syntax for BIGAL's "Multi-Radio button" program and make sure it is loaded before running this.

Edited January 7, 2020 by pkenewell

[Sambuddy]

@pkenewell

Thank you for your post. ACI colour number is a nice touch.

What I would like, as the gif posted above partly explains is 1) to remove certain content with specific colours entirely and 2) change certain content colours to another colour - all this without revising any of the text style or formatting.

As can be seen above, if I have the flexibility of hardcoding my intended colours instead of remembering the colour number I would have a better chance of not messing up and also use corresponding "Multi Radio But" afterward.

This is just an example but all yellow (#51) remains as well as any BYLAYER (black). The content of colour red (#1) is then changed to yellow (#51) and Orange (#30) is then removed.

Again, I was able to substitute but had to luck in removing content of a certain colour.

 

What I liked a bout your code was the ability to remove double spaces as well, something I could not accomplish. That Left/ right trim is something I would like to be able to tackle but with colour conditioning.

 

Thanks  

[Tharwat]

Hi,

Try the following function which should return a list of '((<colour_number> <entity_name>) (<...> <...>)  ... etc) then you can sort the list based on the number of RGB colour which is the first element of the return list of the function.

 

(defun list:by:formatted:colour (/ i s e x p r v n l)
  (if (setq i -1 s (ssget '((0 . "MTEXT"))))
    (while (setq i (1+ i)
                 e (ssname s i)
           )
      (setq x (cdr (assoc 1 (entget e))))
      (and (setq p (vl-string-search "{\\C" x))
           (setq v (substr x (+ p 4) 1)
                 n v
                 p (+ p 4)
           )
           (progn (while (/= (setq r (substr x (setq p (1+ p)) 1)) ";")
                    (setq n (strcat n r))
                  )
                  (setq l (cons (list (read n) e) l))
           )
      )
    )
  )
  l
)

 

[Sambuddy]

@Tharwat

Can I see an executable version of your vision - by the looks of it it may not do what I posted.

Thanks

[Tharwat]

Here is a complete one for you to see the return of the function then I am sure that you can get the rest done otherwise just ask and I will try to go further with the function with what you are after.  

(defun c:Test (/ i s e x p r v n l)
  (if (setq i -1 s (ssget '((0 . "MTEXT"))))
    (while (setq i (1+ i)
                 e (ssname s i)
           )
      (setq x (cdr (assoc 1 (entget e))))
      (and (setq p (vl-string-search "{\\C" x))
           (setq v (substr x (+ p 4) 1)
                 n v
                 p (+ p 4)
           )
           (progn (while (/= (setq r (substr x (setq p (1+ p)) 1)) ";")
                    (setq n (strcat n r))
                  )
                  (setq l (cons (list (read n) e) l))
           )
      )
    )
  )
  (if l (setq l (vl-sort l '(lambda (j k) (< (car j) (car k))))) (princ))
)

 

[Sambuddy]

@Tharwat What I meant was:

 

if you look at my initial code: you see how I substitute one colour with another

(while (vl-string-search "\\C2;" Txt1) (setq Txt1 (vl-string-subst "\\C0;" "\\C2;" Txt1))) ;change (#2) Yellow to (#0) BYBLOCK

This part is alright and I can modify them later to colour I intend.

The part I have issue with is the use if Trim left/right or any other function to remove content from a specific colour.

(defun c:test (/ St1 Con1 Txt1)
	(if (and
		(setq Str1 (car (entsel "\nPick mtext: ")))
		(= "MTEXT" (cdr (assoc 0 (entget Str1))))
		(setq Con1 (vlax-ename->vla-object Str1))
      	    ) ;end and
    			(progn
			  (setq Txt1 (vla-get-textstring Con1))
      	   		  (while (vl-string-search "\\C2;" Txt1) (setq Txt1 (vl-string-subst "\\C0;" "\\C2;" Txt1))) ;change (#2) Yellow to (#0) BYBLOCK
           		  (vla-put-textstring Con1 Txt1)
    			) ;end progn
  	) ;end if
  (princ)
) ;end defun

Essentially, my code and yours does the same but I do not know, on mine, how to remove content based on colour.

Edited January 8, 2020 by Sambuddy

[Tharwat]

Something like this? 

(defun c:Test (/ i s e x p r v n)
  (if (setq i -1
            s (ssget '((0 . "MTEXT")))
      )
    (while (setq i (1+ i)
                 e (ssname s i)
           )
      (setq e (entget e)
            x (cdr (assoc 1 e))
      )
      (and
        (setq p (vl-string-search "{\\C" x))
        (setq n p
              v ""
        )
        (while (/= (setq r (substr x (setq p (1+ p)) 1)) "}")
          (setq v (strcat v r))
        )
        (and (/= v "")
             (entmod
               (subst (cons 1 (strcat (substr x 1 n) (substr x (1+ p))))
                      (assoc 1 e)
                      e
               )
             )
        )
      )
    )
  )
  (princ)
)

 

[Sambuddy]

@Tharwat

The only text in your latest code remain is the the one defined by the layer change, is that right?

 

no worries - this was just for kicks, I will find a way - maybe I am not clear in explaining what my goal is!

 

Thanks

[Tharwat]

Sorry I am having a hard time to get your idea, so just run the codes on a bunch of Mtext that have color formatted strings to see the result by eye and not by reading the codes at the meantime at least.

[Sambuddy]

@Tharwat

It is completely okay - like I said I have a hard time explaining with words what I am trying to accomplish but I will find a way - I have to clear my head!

 

I did run your lisp and it does remove all but content in by layer.

 

Like I said, It is okay - I will find another way (through this I was learning VLA) and I did learn quite a bit so mission is half accomplished.

 

Thanks for your help

[pkenewell]

Here's my new version. This gives you a choice to Change the Color, Strip the Color, or remove the text in that color completely. Give it a try:

 

(defun c:test (/ doc idx opt St1 strcol Con1 ncol Txt1)
   (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
   (if (not g:def)(setq g:def "Strip"))
	(if (and
		    (setq Str1 (car (entsel "\nPick mtext: ")))
          (setq strcol (getstring "\nEnter ACI color number to remove: "))
          (progn
             (initget "Change Strip Remove")
             (if (not (setq opt (getkword (strcat "\nSelect Text Option [Change color/Strip color/Remove text]: <" g:def ">"))))
                (setq opt g:def)
                (setq g:def opt)
             )
          )
		    (= "MTEXT" (cdr (assoc 0 (entget Str1))))
		    (setq Con1 (vlax-ename->vla-object Str1))
       ) ;end and
    	 (progn
		    (setq Txt1 (vla-get-textstring Con1) strcol (strcat "\\C" strcol ";"))
      	 (while (setq idx (vl-string-search strcol Txt1))
             (cond
                ((= opt "Change"); Change to a different color
                    (if (or ncol (setq ncol (getstring "\nEnter new ACI color: ")))
                       (setq txt1 (vl-string-subst (strcat "\\C" ncol ";") strcol Txt1))
                    )
                )
                ((= opt "Strip"); Strips the color codes for the text where found.
                   (setq txt1
                      (strcat
                         (substr txt1 1 idx)
                         (substr txt1 (+ 2 (vl-string-search ";" txt1 idx)))
                      )
                   )
                )
                ((= opt "Remove"); Remove anything in the string up to the next closing brace "}"
                   (setq txt1
                      (strcat
                         (vl-string-right-trim "{" (substr txt1 1 idx))
                         (vl-string-left-trim  "}" (substr txt1 (1+ (vl-string-search "}" txt1 idx))))
                      )
                   )
                )
             )
          )
          (vla-put-textstring Con1 Txt1)
    	 ) ;end progn
  	) ;end if
   (vla-endundomark doc)
  (princ)
) ;end defun

EDIT - Had to make a small correction for the "Change" option.

 

EDIT 2 - Updated "Strip" option so any other Formatting is left intact.

Edited January 8, 2020 by pkenewell

[Tharwat]

1 hour ago, Sambuddy said:

@Tharwat

It is completely okay - like I said I have a hard time explaining with words what I am trying to accomplish but I will find a way - I have to clear my head!

 

I did run your lisp and it does remove all but content in by layer.

 

Like I said, It is okay - I will find another way (through this I was learning VLA) and I did learn quite a bit so mission is half accomplished.

 

Thanks for your help

No worries at all, and you're welcome anytime.

if @pkenewell routine works for you, then that's good otherwise you can upload a sample drawing with BEFORE and AFTER example that can explain your aim of the codes.

Good luck.

[Sambuddy]

@pkenewell

Thank you very much!

Your code was everything I was looking for and more.

 

I can now modify it to hardcode my colour scheme not to use ACI colour number and strip colour or remove content.

 

Great work,

Sorry to both of you for being so messed up in explaining what I wanted!

 

Great Job!

[pkenewell]

1 hour ago, Sambuddy said:

@pkenewell

Thank you very much!

Your code was everything I was looking for and more.

 

I can now modify it to hardcode my colour scheme not to use ACI colour number and strip colour or remove content.

 

Great work,

Sorry to both of you for being so messed up in explaining what I wanted!

 

Thanks Sambuddy. It was a good exercise to try out!  It's not perfect - but it is a good basis to build from.

 

I am not sure that the functions (vl-string-right-trim) and (...left-trim) were needed. Think I might just need to index it better, but I was trying to strip out any extra braces as well in case left behind from another operation. Also - the "Strip" option will leave hidden format grouping braces in the background of the mtext if the color was the only formatting code. I hadn't devised a way to determine other formatting codes within the same set of braces. This shouldn't cause a problem however, as they will remain hidden unless given an escape character.

[Sambuddy]

@pkenewell

 

16 hours ago, pkenewell said:

 

Thanks Sambuddy. It was a good exercise to try out!  It's not perfect - but it is a good basis to build from.

 

I am not sure that the functions (vl-string-right-trim) and (...left-trim) were needed. Think I might just need to index it better, but I was trying to strip out any extra braces as well in case left behind from another operation. Also - the "Strip" option will leave hidden format grouping braces in the background of the mtext if the color was the only formatting code. I hadn't devised a way to determine other formatting codes within the same set of braces. This shouldn't cause a problem however, as they will remain hidden unless given an escape character.

 Thanks to your elegant routine I was able to cater to my need (something I was acking to figure out):

;REMOVE COLOUR (#82)
(while (setq idx (vl-string-search "\\C82;" Txt1))
(setq txt1 (strcat (vl-string-right-trim "{" (substr txt1 1 idx))
(vl-string-left-trim  "}" (substr txt1 (1+ (vl-string-search "}" txt1 idx)))))))

one thing I have a problem or a question:

is there a limited number of arguments i can make within an IF or PROGN or WHILE?

the reason I am asking is that when I execute my routine, It sometimes gives me an error!

Select the Context: ; error: bad argument type: numberp: nil

Here is my revised code with your great job in capturing my vision:

 

(vl-load-com)
(defun c:bell (/ Str1 Con1 Txt1 idx)
	(if (and
		(setq Str1 (car (entsel "\nSelect the Context: ")))
		(= "MTEXT" (cdr (assoc 0 (entget Str1))))
		(setq Con1 (vlax-ename->vla-object Str1))
      	    ) ;end and
(progn
	(setq Txt1 (vla-get-textstring Con1))
	;CHANGE (#150) TO (#BYLAYER)
      	(while (vl-string-search "\\C150;" Txt1) (setq Txt1 (vl-string-subst "" "\\C150;" Txt1)))
	;CHANGE (#7) TO (#BYLAYER)
      	(while (vl-string-search "\\C7;" Txt1) (setq Txt1 (vl-string-subst "" "\\C7;" Txt1)))
	;CHANGE (#0) TO (#BYLAYER)
      	(while (vl-string-search "\\C0;" Txt1) (setq Txt1 (vl-string-subst "" "\\C0;" Txt1)))
	    (while (vl-string-search "\\C2;" Txt1) (setq Txt1 (vl-string-subst "\\C1;" "\\C2;" Txt1)))
  
  	;REMOVE COLOUR (#30)
	(while (setq idx (vl-string-search "\\C30;" Txt1))
	(setq Txt1 (strcat (vl-string-right-trim "{" (substr Txt1 1 idx))
	(vl-string-left-trim  "}" (substr Txt1 (1+ (vl-string-search "}" Txt1 idx)))))))  
  	;REMOVE COLOUR (#51)
	(while (setq idx (vl-string-search "\\C51;" Txt1))
	(setq Txt1 (strcat (vl-string-right-trim "{" (substr Txt1 1 idx))
	(vl-string-left-trim  "}" (substr Txt1 (1+ (vl-string-search "}" Txt1 idx)))))))  
  	;REMOVE COLOUR (#22)
	(while (setq idx (vl-string-search "\\C22;" Txt1))
	(setq Txt1 (strcat (vl-string-right-trim "{" (substr Txt1 1 idx))
	(vl-string-left-trim  "}" (substr Txt1 (1+ (vl-string-search "}" Txt1 idx)))))))  
  	;REMOVE COLOUR (#82)
	(while (setq idx (vl-string-search "\\C82;" Txt1))
	(setq Txt1 (strcat (vl-string-right-trim "{" (substr Txt1 1 idx))
	(vl-string-left-trim  "}" (substr Txt1 (1+ (vl-string-search "}" Txt1 idx)))))))
  	;REMOVE CHARACTER (/)
	(while (setq idx (vl-string-search "/" Txt1))
	(setq Txt1 (strcat (vl-string-right-trim "{" (substr Txt1 1 idx))
	(vl-string-left-trim  "}" (substr Txt1 (1+ (vl-string-search "}" Txt1 idx)))))))

	;SUBSTITUTE (DOUBLE SPACE) WITH (SINGLE SPACE)
      	(while (vl-string-search "  " Txt1) (setq Txt1 (vl-string-subst " " "  " Txt1)))
  	;(while (vl-string-search "BLAH" Txt1) (setq Txt1 (vl-string-subst "TEST" "BLAH" Txt1))) ; WORD SUB
        (vla-put-textstring Con1 Txt1)
) ;end progn
  	) ;end if
  (princ)
) ;end defun

Could you please let me know why I am having this error with some Mtext - perhaps the number of characters or arguments exceeds the limit - is there such thing or is there an issue in my routine? The TEXT SAMPLE.dwg attached works but anything with longer content seems to come up with an error!

TEXT SAMPLE.dwg

Edited January 9, 2020 by Sambuddy

[Sambuddy]

@BIGAL

By the way, I am using your DCL in any instance I can. It is making my job so much easier you have no idea!

 

Thank you for sharing your multi selection as well as radio button - graphically it is so much easier to use this than to memorize a bunch of commands that you just developed and keep forgetting!

 

Thank you again!