Jump to content

HELP: Change only the colour of numbers in an mtext

vernonlee

By vernonlee
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

vernonlee Proficient

vernonlee

Posted
Posted

I have a bunch of mtext that has a mixture of letters & numbers.

 

I need to change the colours of only the numbers

 

example:

 

"ROOM 15" >>>>> "ROOM 15"

 

Currently i have to double click each & every mtext to go into the edit mode to highlight those numbers & click the required colour.

 

Anyone can come up with a LISP/marco script that changes the colour for only the numbers just by selecting the required mtext?

 

Thanks

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Do a bit of research about how mtext is created and then its easy there is a hidden colour control. Just read the mtext 1 character at a time and check its (Ascii x) to see if its in the range 48-57 and if yes set colour flag and update. I am trying to find a mtext routine I have one somewhere, this was asked once before and some code was posted.

 

Your example room 12 TextString = "room {\\C1;12}" you can see control codes

 

Ok (ascii "9") is 57 so just use substr to walk through the text til it finds a number less than 58 more than 48 then rewrite the text adding \\Cx; in the middle x i colour as a number 1 is red.

 

http://www.cadforum.cz/cadforum_en/text-formatting-codes-in-mtext-objects-tip8640

Edited by BIGAL
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

A start a work in progress

 


(defun C:textcol ( / X obj ans char1)
(setq obj (entget (car (entsel "Pick Mtext" )))) ; do a check for mtext
(setq x "130") ; dummy colour number use a getint and rtos note c is rgb C is number
(setq str (cdr (assoc 1 obj)))
(setq ans "") ; blank string
(setq keepgoing 1) ; 1st character

(while (<= keepGoing (strlen str)) ; repeat for length of text
(setq char1 (substr str keepGoing 1))

(if (and (< 48 (ascii char1))(> 57 (ascii char1))) ; 0 is 48 9 is 57
(setq ans (strcat ans "{\\C" X ";" char1 "}")) ; this allows for a number in middle of text
(setq ans (strcat ans char1)) 
)
 
(setq keepGoing (+ keepGoing 1)) 
)

(entmod (subst (cons 1 ans) (assoc 1 obj) obj))
(princ)
)

Edited by BIGAL
Updated
  • Like 1
Tharwat Grand Master

Tharwat

Posted
Posted

Try this program and let me know .

 

(defun c:Test (/ s i en st x l)
 ;;------------------------------------;;
 ;;	Tharwat 31.05.2015		;;
 ;; Color number in Mtext to Blue = 5	;;
 ;;------------------------------------;;
 (if (setq s (ssget "_:L" '((0 . "MTEXT") (-4 . "<NOT")(1 . "*{\\*;*}*")(-4 . "NOT>"))))
   (repeat (setq i (sslength s))
     (setq en (entget (ssname s (setq i (1- i))))
           st (cdr (assoc 1 en))
           x  ""
     )
     (mapcar '(lambda (n)
                (if (member n '(48 49 50 51 52 53 54 55 56 57))
                  (setq l (cons (strcat x "{\\C5;" (chr n) "}") l)
                  )
                  (setq l (cons (strcat x (chr n)) l)
                  )
                )
              )
             (vl-string->list st)
     )
     (entmod (subst (cons 1 (apply 'strcat (reverse l)))
                    (assoc 1 en)
                    en
             )
     )
     (setq l nil)
   )
 )
 (princ)
)(vl-load-com)

Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)

I would suggest the use of Regular Expressions for this task - the following should account for MText containing a mixture of coloured & non-coloured numerical content, and also accounts for negative numbers & decimals: 

;; Colour Numerical MText  -  Lee Mac

(defun c:numcol ( / *error* enx idx rgx sel str )

   (defun *error* ( msg )
       (if (and (= 'vla-object (type rgx)) (not (vlax-object-released-p rgx)))
           (vlax-release-object rgx)
       )
       (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (if (setq sel (ssget "_:L" '((0 . "MTEXT") (1 . "*#*"))))
       (if (setq rgx (vlax-get-or-create-object "vbscript.regexp"))
           (progn
               (vlax-put-property rgx 'global     actrue)
               (vlax-put-property rgx 'ignorecase acfalse)
               (vlax-put-property rgx 'multiline  actrue)
               (vlax-put-property rgx 'pattern "(-?\\d+(?:\\.\\d)?\\d*)(?![0-9;}\\|])")
               (repeat (setq idx (sslength sel))
                   (setq enx (entget (ssname sel (setq idx (1- idx))))
                         str (assoc 1 enx)
                   )
                   (entmod (subst (cons 1 (vlax-invoke rgx 'replace (cdr str) "{\\C1;$1}")) str enx))
               )
           )
           (princ "\nUnable to interface with RegExp object.")
       )
   )
   (*error* nil)
   (princ)
)
(vl-load-com) (princ)
 
Edited by Lee Mac
vernonlee Proficient

vernonlee

Posted
  • Author
Posted (edited)

Hi guys. Thanks for the help. I was having a long weekend hence the late reply.

 

I tested each LISP & have different results.

 

I also attached the dwg for reference as well.

 

So far, base on my drawing I am working on, Lee's LISP work. But, only when the letters & number are the same colour.

 

I would suggest the use of Regular Expressions for this task - the following should account for MText containing a mixture of coloured & non-coloured numerical content

 

Lee, I tested it & if the number is already of a different colour then the text, the number will not change colour.

 

BTW, Lee, how to change the LISP to different colour other then red? The colour i require is actually megenta.

Untitled.jpg

CHANGING NUMBER ONLY LISP RESULT.dwg

Edited by vernonlee
Tharwat Grand Master

Tharwat

Posted
Posted

My routine did not work or actually did not allow you to select the Mtext object because it is formatted Mtext object , so make a new Mtext with changing any format inside the Mtext dialog and try the routine once again.

vernonlee Proficient

vernonlee

Posted
  • Author
Posted
My routine did not work or actually did not allow you to select the Mtext object because it is formatted Mtext object , so make a new Mtext with changing any format inside the Mtext dialog and try the routine once again.

 

Hi Tharwat

 

I understand what you mean. But the reason behind this LISP is to do a quick change of colours for the numbering of an existing mtext. Hence it would defeat the purpose if I were to create a new text.

Tharwat Grand Master

Tharwat

Posted
Posted

Agree with you .

 

Just wait for Lee because he went with the best choice by using the Regular Expression ( Regex method as it is known in C# ) and it is easy to add an option to the user to pick any color they want from a Colour Dialouge .

Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)
vernonlee said:
Lee, I tested it & if the number is already of a different colour then the text, the number will not change colour.

 

This was originally by design - I figured that if the user had intentionally applied a colour override to the numerical content or to the section of text surrounding the numerical content, that they would not want such colour to be altered.

 

vernonlee said:
BTW, Lee, how to change the LISP to different colour other then red? The colour i require is actually megenta.

 

I have now included a separate parameter clearly noted in the updated code below, which you can use to change the ACI colour applied to the numerical content (6 = Magenta).

 

The following should perform successfully for all but a handful of edge cases: 

;; Colour Numerical MText  -  Lee Mac

(defun c:numcol ( / *error* col enx idx pat new rgx sel str )

   (setq col 6 ;; ACI colour for numerical text
         pat "(?:\\{\\\\C\\d+\\;(-?\\d+(?:\\.\\d)?\\d*)\\})|(?-?\\d+(?:\\.\\d)?\\d*)([^0-9;|]{1}))"
         new (strcat "{\\C" (itoa col) ";$1$2}$3")
   )

   (defun *error* ( msg )
       (if (and (= 'vla-object (type rgx)) (not (vlax-object-released-p rgx)))
           (vlax-release-object rgx)
       )
       (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (if (setq sel (ssget "_:L" '((0 . "MTEXT") (1 . "*#*"))))
       (if (setq rgx (vlax-get-or-create-object "vbscript.regexp"))
           (progn
               (vlax-put-property rgx 'global     actrue)
               (vlax-put-property rgx 'ignorecase acfalse)
               (vlax-put-property rgx 'multiline  actrue)
               (vlax-put-property rgx 'pattern    pat)
               (repeat (setq idx (sslength sel))
                   (setq enx (entget (ssname sel (setq idx (1- idx))))
                         str (assoc 1 enx)
                   )
                   (entmod (subst (cons 1 (vlax-invoke rgx 'replace (cdr str) new)) str enx))
               )
           )
           (princ "\nUnable to interface with RegExp object.")
       )
   )
   (*error* nil)
   (princ)
)
(vl-load-com) (princ)
 

 

Quick demo showing compatibility with existing MText formatting:

 

colournummtext.gif

Edited by Lee Mac
vernonlee Proficient

vernonlee

Posted
  • Author
Posted
This was originally by design - I figured that if the user had intentionally applied a colour override to the numerical content or to the section of text surrounding the numerical content, that they would not want such colour to be altered.

 

 

 

I have now included a separate parameter clearly noted in the updated code below, which you can use to change the ACI colour applied to the numerical content (6 = Magenta).

 

Hi Lee. Thanks for the detail explanation with the video.

 

Apologies but now the result is the opposite. The number cannot change colour when the letter & number is of the same colour.

 

It only changes when text & number is of different colour.

 

Perhaps there was a miscommunication.

 

Your initial LISP gave the result i needed (number change colour when number/letter colour is the same), except I wanted a choice of other colours.

 

I only mention the part where numbers do not change when number/letter is of different colour, because I though you created the initial LISP to enable the number to change regardless whether number/letter is of the same or different colours.

 

My drawing actually consists of only mtext with letters & numbers are of the same colour to begin with.

 

Hope you can revert back to the initial LISP but with a choice of colours like in the 2nd LISP. :oops:

Lee Mac Grand Master

Lee Mac

Posted
Posted

Please upload a drawing showing the desired result and the cases for which you believe the program is returning an incorrect result.

vernonlee Proficient

vernonlee

Posted
  • Author
Posted
Please upload a drawing showing the desired result and the cases for which you believe the program is returning an incorrect result.

 

Hi Lee.

 

Attached as requested.

 

 

CHANGING NUMBER ONLY LISP.dwg

Untitled2.jpg

Lee Mac Grand Master

Lee Mac

Posted
Posted

Please try the following:

;; Colour Numerical MText  -  Lee Mac

(defun c:numcol ( / *error* col idx pat new obj rgx sel )

   (setq col 6 ;; ACI colour for numerical text
         pat "(?:\\{\\\\C\\d+\\;(-?\\d+(?:\\.\\d)?\\d*)\\})|(?-?\\d+(?:\\.\\d)?\\d*)([^0-9;|]{1}|$))"
         new (strcat "{\\C" (itoa col) ";$1$2}$3")
   )

   (defun *error* ( msg )
       (if (and (= 'vla-object (type rgx)) (not (vlax-object-released-p rgx)))
           (vlax-release-object rgx)
       )
       (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (if (setq sel (ssget "_:L" '((0 . "MTEXT") (-4 . "<OR") (1 . "*#*") (3 . "*#*") (-4 . "OR>"))))
       (if (setq rgx (vlax-get-or-create-object "vbscript.regexp"))
           (progn
               (vlax-put-property rgx 'global     actrue)
               (vlax-put-property rgx 'ignorecase acfalse)
               (vlax-put-property rgx 'multiline  actrue)
               (vlax-put-property rgx 'pattern    pat)
               (repeat (setq idx (sslength sel))
                   (vla-put-textstring
                       (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                       (vlax-invoke rgx 'replace (vla-get-textstring obj) new)
                   )
               )
           )
           (princ "\nUnable to interface with RegExp object.")
       )
   )
   (*error* nil)
   (princ)
)
(vl-load-com) (princ)

 

The issue was not related to the existing colour of the text, but rather that the number was the last character in the string; I have also updated the program to account for MText with long text content which spans multiple DXF groups (thanks to ronjonp for the suggestion).

vernonlee Proficient

vernonlee

Posted
  • Author
Posted
Please try the following:

 

The issue was not related to the existing colour of the text, but rather that the number was the last character in the string; I have also updated the program to account for MText with long text content which spans multiple DXF groups (thanks to ronjonp for the suggestion).

 

Hi Lee,

 

It is working perfectly now :)

 

Thanks for helping me to resolve it. :beer:

  • 1 month later...
Lee Mac Grand Master

Lee Mac

Posted
Posted

Such exceptions will need to be modified manually; I am not looking to develop this program any further on voluntary time.

vernonlee Proficient

vernonlee

Posted
  • Author
Posted
Such exceptions will need to be modified manually; I am not looking to develop this program any further on voluntary time.

 

I understand Lee.

 

Still, thanks for the help :)

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...