Arrange MText by colour

January 8, 2020

Hmm not sure - but Try this instead - much shorter:

(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 these codes to bylayer. NOTE: You have to use replacement code of 256. Otherwise if there are no braces and a different color
         ; code behind this one, it will just change to the previous color.
         (foreach n (list "\\C150;" "\\C7;" "\\C0;")
            (while (vl-string-search n Txt1) (setq Txt1 (vl-string-subst "\\C256;" n Txt1))) 
         )

         ; Change Color #2 to Color #1
      	(while (vl-string-search "\\C2;" Txt1) (setq Txt1 (vl-string-subst "\\C1;" "\\C2;" Txt1)))
         
         ; Remove text for these colors. There us a BIG problem for this if multiple color codes are within a single set of braces!
         (foreach n (list "\\C30;" "\\C51;" "\\C22;" "\\C82;")
            (while (setq idx (vl-string-search n Txt1))
         	  (setq Txt1
                 (strcat
                    (vl-string-right-trim "{" (substr Txt1 1 idx))
         	        (vl-string-left-trim  "}" (substr Txt1 (1+ (vl-string-search "}" Txt1 idx))))
                 )
              )
            )
         ) ;End Foreach

        	; REMOVE CHARACTER (/)
         (while (vl-string-search "/" Txt1) (setq Txt1 (vl-string-subst "" "/" Txt1)))

      	; 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

IMPORTANT NOTE: There is a problem with the "remove text" part that I have not resolved. If the color is subordinate to the other formatting; i.e. within the braces there are additional color changes (like "{\\I\\C30;ORANGE \\C256;TEXT\\i}" for example, then more text than what you want will be removed! I have not yet figured out how to fix this problem yet. I need to figure out how to parse the string differently.

EDIT 1: Had to make a change to the "Bylayer" color change loop. See the comments.

EDIT 2: fixed a mistake in my foreach loop.

Edited January 9, 2020 by pkenewell

January 8, 2020

Ok - Solved the problem I had with Removing test with the color codes. I have to use a much more complex parsing method. Perhaps you can apply this to your version of the program. I recommend putting this in the (foreach...) loop like the example I put in the above version.

(defun c:test (/ _StrParse doc idx opt St1 strcol Con1 ncol p1 p2 p3 pr Txt1)

   (defun _StrParse (str del / pos)
     (if (and str del)
        (if (setq pos (vl-string-search del str))
          (cons (substr str 1 pos) (_StrParse (substr str (+ pos 1 (strlen del))) del))
          (list str)
        )
     )
   )

   (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: ")
                strcol (if (= strcol "~")(itoa (acad_colordlg 256)) strcol)
                strcol (if strcol strcol nil)
          )
          (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"); Option to Remove anything in the string up to the next closing brace "}" OR the next color code "\\C"
                         ; Parse the string at the color code we are looking for
                   (setq pr (_StrParse txt1 strcol)
                         ; Save the first part of the string before the color code and strip any opening brace that was right before it.
                         ; if there are other formatting codes prior to the color code - there will be no brace immediately on the right end.
                         p1 (vl-string-right-trim "{" (car pr))
                         ; Recombine the remaining parcels of the string with the same color code - strip extra added one at the end.
                         ; Reinserting the color code in additional pieces that have the same color so they will be found in the next loop.
                         p2 (vl-string-right-trim strcol (apply 'strcat (mapcar '(lambda (x)(strcat x strcol)) (cdr pr))))
                         ; Parse the string at the next closing brace to shorten the search for other color codes.
                         pr (_StrParse p2 "}")
                         ; Save the next part of the string up to the brace and add the brace back in.
                         p2 (strcat (car pr) "}")
                         ; if there are additional string parts after the "}" recombine them with the brace - strip the added one at the end
                         p3 (if (cdr pr)(vl-string-right-trim "}" (apply 'strcat (mapcar '(lambda (x) (strcat x "}")) (cdr pr)))))
                         ; Search for another color code within the portion of the string up to the closing brace and parse it. Leaves behind the color numbers
                         pr (_StrParse p2 "\\C")
                         ; If there is any portions of the string ater the next color code, recombine them with their color codes. NOTE - the first part of the
                         ; string is discarded - which is the part we need to remove. If there are no other color codes, the remainder of the string
                         ; is discarded up to the next closing brace.
                         p2 (if (cdr pr)
                               (apply 'strcat (mapcar '(lambda (x)(strcat "\\C" x)) (cdr pr)))
                           )
                   )
                   ; Recombine the remaining parts of the string (if they exist or "" empty string).
                   (setq txt1 (strcat p1 (if p2 p2 "")(if p3 p3 "")))
                )
             )
          )
          (vla-put-textstring Con1 Txt1)
    	 ) ;end progn
  	) ;end if
   (vla-endundomark doc)
  (princ)
) ;end defun

EDIT - Corrected am invalid function call to "pjk-StrParse" that was in the recursive "_Strparse" function. I renamed the function but forgot to rename the recursive call! Oops!

Edited January 9, 2020 by pkenewell

January 9, 2020

@pkenewell

Thanks again for your shot at this.

Is "pjk-StrParse" a function defined under defun _StrParse?

Maybe I do not get it but what is happening.

And the second "IF" bracket follows the entire routine - perhaps there are a few extra right paran in there.

in general, what are we doing with defun _StrParse?

Please let me know if you found out.

Thanks

Edited January 9, 2020 by Sambuddy

January 9, 2020

3 hours ago, Sambuddy said:

@pkenewell

Thanks again for your shot at this.

Is "pjk-StrParse" a function defined under defun _StrParse?

Maybe I do not get it but what is happening.

And the second "IF" bracket follows the entire routine - perhaps there are a few extra right paran in there.

in general, what are we doing with defun _StrParse?

Please let me know if you found out.

Thanks

Oops. Sorry - I forgot to rename the recursive call when I renamed the function from my original. Funny - it worked for me because I had both identical functions defined and loaded in my AutoCAD. I have updated the code above. Otherwise it should work correctly - I did not see any extra parens, so make sure you copy it correctly.

FYI - _Strparse is a function that parses a string using a set of characters. For example (_strparse "TEST1;TEST2;TEST3" ";") would parse the string at the ";" character and return a list of the parts in between: i.e. '("TEST1" "TEST2" "TEST3").

I am using (_Strparse) as a shortcut to split the string at the closing brace "}" character or the next "\\C" code. to figure out what to remove in the string - because my previous version did not work in some cases. It is hard to explain, but I will try to comment my code above to show my reasoning.

NOTE: I also made some additional changes to preserve other formatting.

Edited January 9, 2020 by pkenewell

January 9, 2020

Here is a final version I put together that has:

1) more error trapping to prevent invalid colors from being entered,

2) displays error if non MTEXT object is selected, or the color is not found in the string.

3) eliminates any extra prompting if conditions aren't met beforehand.

I gave it the command name "RTC".

Other Feature: It can display an AutoCAD color dialog at the color prompt by typing in a tilde (~) character - similar to behavior in other AutoCAD commands.

RemoveTextColor.lsp

Edited January 9, 2020 by pkenewell
New file version: Added more commenting and validation.

January 9, 2020

@pkenewell

Thanks for figuring this out!

Quick question: How do you suppress a customized command options similar to say "Insert or Circle or ..." in order to key in a specific function of yours without having to modify the original routine.

Say in my case, if I keep your routine as is and want to only use the remove option your provided but key in my colour # or the optional keywords to reflect specific changes.

You know how you would do "_None" on a macro command and do your own setting? Is it possible in this case for instance?

By the way, your work on this amazes me! Thank you VERY much!

January 9, 2020

@pkenewell

One more curiosity question: like I did in the previous lisp, I could run certain routines in the background presenting the users with radio DCl options. On the last one, I am bit stuck.

Perhaps if there is an answer to my last question about running routines in the background could help, i.e. not to give strip/change/remove options but do it in the background by giving them options A/B/C/D where for example: option "A" could remove certain colours, change colours, strip colours and replace certain words, option B through D same thing.

It takes some time to remove 4-5 colours one by one, then strip another 2-3 something like this.

To make it short, I do not know where I could implement my Option A through D to process the text without user input on colour selection. similar to our first few versions! option to modify multiple colours! like so:

(foreach n (list "\\C150;" "\\C7;" "\\C0;")
)

Any ideas?

Edited January 9, 2020 by Sambuddy

January 9, 2020

I'm not sure I understand you correctly. If you want to bypass the Remove option, you would have to either change the program, or do a toolbar macro that would mirror the prompts of the program - something like "^C^CRTC;\;4;Remove;".

I would recommend you write the program the way you need it written. But - if you can't figure it out - see below:

I simply took the "remove" part from my program and dropped it into your version - BELL.

(vl-load-com)

(defun c:bell (/ _StrParse doc Str1 Con1 Txt1 idx p1 p2 p3 pr)

   (defun _StrParse (str del / pos)
     (if (and str del)
        (if (setq pos (vl-string-search del str))
          (cons (substr str 1 pos) (_StrParse (substr str (+ pos 1 (strlen del))) del))
          (list str)
        )
     )
   )

   (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))

	(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 these codes to bylayer. NOTE: You have to use replacement code of 256. Otherwise if there are no braces and a different color
         ; code behind this one, it will just change to the previous color.
         (foreach n (list "\\C150;" "\\C7;" "\\C0;")
            (while (vl-string-search n Txt1) (setq Txt1 (vl-string-subst "\\C256;" n Txt1)))
         )

         ; Change Color #2 to Color #1
      	(while (vl-string-search "\\C2;" Txt1) (setq Txt1 (vl-string-subst "\\C1;" "\\C2;" Txt1)))

         ; Remove text for these colors. There us a BIG problem for this if multiple color codes are within a single set of braces!
         (foreach n (list "\\C30;" "\\C51;" "\\C22;" "\\C82;")
            (while (setq idx (vl-string-search n Txt1))
               (setq pr (_StrParse txt1 n)
                     ; Save the first part of the string before the color code and strip any opening brace that was right before it.
                     ; if there are other formatting codes prior to the color code - there will be no brace immediately on the right end.
                     p1 (vl-string-right-trim "{" (car pr))
                     ; Recombine the remaining parcels of the string with the same color code - strip extra added one at the end.
                     ; Reinserting the color code in additional pieces that have the same color so they will be found in the next loop.
                     p2 (vl-string-right-trim n (apply 'strcat (mapcar '(lambda (x)(strcat x n)) (cdr pr))))
                     ; Parse the string at the next closing brace to shorten the search for other color codes.
                     pr (_StrParse p2 "}")
                     ; Save the next part of the string up to the brace and add the brace back in.
                     p2 (strcat (car pr) "}")
                     ; if there are additional string parts after the "}" recombine them with the brace - strip the added one at the end
                     p3 (if (cdr pr)(vl-string-right-trim "}" (apply 'strcat (mapcar '(lambda (x) (strcat x "}")) (cdr pr)))))
                     ; Search for another color code within the portion of the string up to the closing brace and parse it. Leaves behind the color numbers
                     pr (_StrParse p2 "\\C")
                     ; If there is any portions of the string ater the next color code, recombine them with their color codes. NOTE - the first part of the
                     ; string is discarded - which is the part we need to remove. If there are no other color codes, the remainder of the string
                     ; is discarded up to the next closing brace.
                     p2 (if (cdr pr)(apply 'strcat (mapcar '(lambda (x)(strcat "\\C" x)) (cdr pr))))
               )
                   ; Recombine the remaining parts of the string (if they exist or "" empty string).
                   (setq txt1 (strcat p1 (if p2 p2 "")(if p3 p3 "")))
            )
         ) ;End Foreach

        	; REMOVE CHARACTER (/)
         (while (vl-string-search "/" Txt1) (setq Txt1 (vl-string-subst "" "/" Txt1)))

      	; 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

  (vla-endundomark doc)
  (princ)
) ;end defun

January 9, 2020

@pkenewell

I guess I do not even know what I want - do not worry hah!

Thanks

January 9, 2020

24 minutes ago, Sambuddy said:
@pkenewell

One more curiosity question: like I did in the previous lisp, I could run certain routines in the background presenting the users with radio DCl options. On the last one, I am bit stuck.

Perhaps if there is an answer to my last question about running routines in the background could help, i.e. not to give strip/change/remove options but do it in the background by giving them options A/B/C/D where for example: option "A" could remove certain colours, change colours, strip colours and replace certain words, option B through D same thing.

It takes some time to remove 4-5 colours one by one, then strip another 2-3 something like this.

To make it short, I do not know where I could implement my Option A through D to process the text without user input on colour selection. similar to our first few versions! option to modify multiple colours! like so:
(foreach n (list "\\C150;" "\\C7;" "\\C0;")
)
Any ideas?

See the updated program in my previous post. Sorry the previous version of the rewrite i did to your BELL program, there was a simple error in the foreach loops that I missed. It is corrected in the last version I made in the previous post, as well as the older version.

January 9, 2020

1 minute ago, Sambuddy said:

@pkenewell

I guess I do not even know what I want - do not worry hah!

Thanks

Did you try out my last version of BELL? (2) posts up HERE

January 9, 2020

3 minutes ago, pkenewell said:

See the updated program in my previous post. Sorry the previous version of the rewrite i did to your BELL program, there was a simple error in the foreach loops that I missed. It is corrected in the last version I made in the previous post, as well as the older version.

You are Great Man!

oh yeah! I am going to make that the basis of my work!

Great to have you around buddy.

Thanks

Edited January 9, 2020 by Sambuddy

January 9, 2020

Just now, Sambuddy said:

You are Great Man!

Thanks

No problem. I suggest you step through my "RemoveTextColor.lsp" program very carefully and learn some of the programming ideas presented. There is allot of information to be learned in it. Concepts such as defining and redefining the same variable within the same "setq" statement, use of "nil" or "T" within an "If" or "Progn" to force the return of a statement, using "wcmatch" to validate a number, etc... Not to mention using string parsing.

January 9, 2020

@pkenewell

Hey,

I promise the last question on this topic: for the kicks though:

if you have real numbers within a text, say 112.50 m or 15.60 m or 2.65 m or in French 112,50 m or 15,60 m or 2,65 m (comma instead of dot)

could you think of a filter/ condition to correct the numbers so that they are always consistent that (m) would have no space and (comma) is replaced with (dot) ONLY for real numbers - and may be colour change to top it off hah?

January 9, 2020

I agree - and your comments help a lot as well!

Job well done!

Until last week I did not even know how to create a routine using VLA.

Great!

January 9, 2020

11 minutes ago, Sambuddy said:

I agree - and your comments help a lot as well!

Job well done!

Until last week I did not even know how to create a routine using VLA.

Great!

FYI - I updated the RemoveTextColor.lsp again to add a few more comments and minor fixes for some of the validation on the color number.

January 9, 2020

3 hours ago, Sambuddy said:

@pkenewell

Hey,

I promise the last question on this topic: for the kicks though:

if you have real numbers within a text, say 112.50 m or 15.60 m or 2.65 m or in French 112,50 m or 15,60 m or 2,65 m (comma instead of dot)

could you think of a filter/ condition to correct the numbers so that they are always consistent that (m) would have no space and (comma) is replaced with (dot) ONLY for real numbers - and may be colour change to top it off hah?

It's doable given certain conditions are consistent. meaning a string that has a decimal point or comma, and has a digit before and a digit after - ALWAYS constitutes a distance value per the selected text. I have seen examples of strings for description codes like "E0,5-01 Level 2" or some such number. This meets all the conditions, but is not a distance value.

If this IS consistent. The its just a matter of parsing by the comma (use my "_Strparse" function), then checking the character before (end of the previous string part) and after (beginning of the next string part) to determine if they are both digits. If both are digits, then change the comma to a decimal point, otherwise - reinsert a comma.

Sorry - I am out of time to code for you right now, but see if you can logically work it out.

Sign In

Arrange MText by colour

Recommended Posts

pkenewell

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

pkenewell

Sambuddy

pkenewell

pkenewell

Sambuddy

Sambuddy

pkenewell

Sambuddy

pkenewell

pkenewell

Sambuddy

pkenewell

Sambuddy

Sambuddy

pkenewell

pkenewell

Join the conversation

Tutorials

Forums

Activity