Looking for a LSP to select a dimension in the drawing and change the color to red for any type of dimension, be it a rotated, aligned, or angular.

[Ashishs]

On 11/27/2024 at 7:06 PM, pkenewell said:

@Ashishs This is not perfect, but it attempts to strip out any color codes from the Text in the Mleader before replacing with the new color code. Try the updated code.

;|==============================================================
dimcol.lsp by Phil Kenewell - 11/25/2024

Description:
   By request of a user on CADTutor.com
   https://www.cadtutor.net/forum/topic/94150-looking-for-a-lsp-to-select-a-dimension-in-the-drawing-and-change-the-color-to-red-for-any-type-of-dimension-be-it-a-rotated-aligned-or-angular/

   This program allows you to change the color of all selected Dimensions
   and Leaders, QLeader, Mleaders.
   
Last Update:
   11/27/2024 = Added variable cl and (acad_colordlg) to select the
                color at start instead of hardcoding.
===============================================================|;

(defun c:dimcol (/ cl co e e2 i l l2 n o ss tx)
   (vl-load-com)
   ;-----------------------------
   ;; Change this variable to Change the color. ACI color number integer:
   (setq cl 5); 1=RED, 2=YELLOW, 3=GREEN, 4=CYAN, 5=BLUE, 6=MAGENTA etc...
   ;(setq cl (acad_colordlg cl)); Alternately select color at beginning.
   ;---------------------------------------------------------------------
   (command "._undo" "_Begin")
   (if (setq ss (ssget '((0 . "DIMENSION,*LEADER"))))
      (repeat (setq i (sslength ss))
         (setq e (ssname ss (setq i (1- i)))
               l (entget e)
         )
         (cond
            ((wcmatch (cdr (assoc 0 l)) "DIMENSION,LEADER,QLEADER")
               (command "._dimoverride" "_dimclre" cl "_dimclrd" cl "_dimclrt" cl "" e "")
               (if (assoc 340 l)
                  (progn
                     (setq l2 (entget (setq e2 (cdr (assoc 340 l)))))
                     (if (assoc 62 l2)
                        (progn (entmod (subst (cons 62 cl) (assoc 62 l2) l2))(entupd e2))
                        (progn (entmod (append l2 (list (cons 62 cl))))(entupd e2))
                     )
                  )
               )
            )
            ((= (cdr (assoc 0 l)) "MULTILEADER")
               (if (assoc 62 l)
                  (progn (entmod (subst (cons 62 cl) (assoc 62 l) l))(entupd e))
                  (progn (entmod (append l (list (cons 62 cl))))(entupd e))
               )
               (setq o  (vlax-ename->vla-object e)
                     co (vla-get-leaderlinecolor o)
                     tx (vla-get-textstring o)
               )
               (vla-put-colorindex co cl)
               (vla-put-leaderlinecolor o co)
               (while (wcmatch tx "*\\C*;*")
                  (setq n 0)
                  (repeat 257
                     (setq tx (vl-string-subst "" (strcat "\\C" (itoa n) ";") tx)
                            n (1+ n)
                     )
                  )
               )
               (vla-put-textstring o
                   (strcat "\\C" (itoa cl) ";" tx)
               )
               
            )
         )
      )
   )
   (command "._Undo" "_End")
   (princ)
)

 

Hi, Can this routine be modified to also include the text and Mtext objects as well along with the dimensions to change color?

[pkenewell]

4 hours ago, Ashishs said:

Hi, Can this routine be modified to also include the text and Mtext objects as well along with the dimensions to change color?

Yes, but I would recommend a separate routine for it:

(defun c:TextCol (/ c cl e i l o ss x)
   (vl-load-com)
   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
   (if (and
         (setq ss (ssget '((0 . "*TEXT"))))
         (setq cl 5 cl (acad_colordlg cl T))
      )
      (repeat (setq i (sslength ss))
         (setq e (ssname ss (setq i (1- i)))
               l (entget e)
               o (vlax-ename->vla-object e)
               x (vla-get-textstring o)
               c (vla-get-truecolor o)
         )
         (vla-put-colorindex c cl)
         (vla-put-truecolor o c)
         (if (= (cdr (assoc 0 l)) "MTEXT")
            (progn
               (while (wcmatch x "*\\C*;*")
                  (setq n 0)
                  (repeat 257
                     (setq x (vl-string-subst "" (strcat "\\C" (itoa n) ";") x)
                           n (1+ n)
                     )
                  )
               )
               (vla-put-textstring o x)
            )
         )
      )
   )
   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
   (princ)
)

 

[Ashishs]

On 12/3/2024 at 5:56 PM, pkenewell said:

Yes, but I would recommend a separate routine for it:

(defun c:TextCol (/ c cl e i l o ss x)
   (vl-load-com)
   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
   (if (and
         (setq ss (ssget '((0 . "*TEXT"))))
         (setq cl 5 cl (acad_colordlg cl T))
      )
      (repeat (setq i (sslength ss))
         (setq e (ssname ss (setq i (1- i)))
               l (entget e)
               o (vlax-ename->vla-object e)
               x (vla-get-textstring o)
               c (vla-get-truecolor o)
         )
         (vla-put-colorindex c cl)
         (vla-put-truecolor o c)
         (if (= (cdr (assoc 0 l)) "MTEXT")
            (progn
               (while (wcmatch x "*\\C*;*")
                  (setq n 0)
                  (repeat 257
                     (setq x (vl-string-subst "" (strcat "\\C" (itoa n) ";") x)
                           n (1+ n)
                     )
                  )
               )
               (vla-put-textstring o x)
            )
         )
      )
   )
   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
   (princ)
)

 

Thanks a lot. But it's not working on multileader texts. Please check the attached drawing.

Multileader.dwg

[pkenewell]

On 12/7/2024 at 5:39 AM, Ashishs said:

Thanks a lot. But it's not working on multileader texts. Please check the attached drawing.

Yes - As I implied previously - this is a separate routine, and should be used in addition to the DIMCOL routine.

[Ashishs]

Hi,

 

Please check the attached drawing. I am not able to change the color of this particular Mtext using the routine.

 

 

 

Drawing1.dwg

[SLW210]

THIS LISP? 

 

 

Works for me.

 

 

TextColordwg.dwg

[pkenewell]

2 hours ago, Ashishs said:

Hi,

 

Please check the attached drawing. I am not able to change the color of this particular Mtext using the routine.

 

 

 

Drawing1.dwg 34.76 kB · 1 download

 

@Ashishs Works for me as well as @SLW210 on your example drawing. I don't see any problem.

 

 

Edited May 8 by pkenewell

[Ashishs]

On 5/8/2025 at 11:46 AM, pkenewell said:

 

@Ashishs Works for me as well as @SLW210 on your example drawing. I don't see any problem.

 

 

 

 

Below is the LSP I am using, which is not working on this text. Please let me know if anything is missing.

;; Written by PJK 11/26/2024
;; Topic: https://www.cadtutor.net/forum/topic/94150-looking-for-a-lsp-to-select-a-dimension-in-the-drawing-and-change-the-color-to-red-for-any-type-of-dimension-be-it-a-rotated-aligned-or-angular/
;|==============================================================
dimcol.lsp by Phil Kenewell - 11/25/2024

Description:
   By request of a user on CADTutor.com
  https://www.cadtutor.net/forum/topic/94150-looking-for-a-lsp-to-select-a-dimension-in-the-drawing-and-change-the-color-to-red-for-any-type-of-dimension-be-it-a-rotated-aligned-or-angular/

   This program allows you to change the color of all selected Dimensions
   and Leaders, QLeader, Mleaders.
   
Last Update:
   11/27/2024 = Added variable cl and (acad_colordlg) to select the
                color at start instead of hardcoding.
===============================================================|;

(defun c:dimred (/ cl co e e2 i l l2 n o ss tx)
   (vl-load-com)
   ;-----------------------------
   ;; Change this variable to Change the color. ACI color number integer:
   (setq cl 10); 1=RED, 2=YELLOW, 3=GREEN, 4=CYAN, 5=BLUE, 6=MAGENTA etc...
   ;(setq cl (acad_colordlg cl)); Alternately select color at beginning.
   ;---------------------------------------------------------------------
   (command "._undo" "_Begin")
   (if (setq ss (ssget '((0 . "DIMENSION,*LEADER"))))
      (repeat (setq i (sslength ss))
         (setq e (ssname ss (setq i (1- i)))
               l (entget e)
         )
         (cond
            ((wcmatch (cdr (assoc 0 l)) "DIMENSION,LEADER,QLEADER")
               (command "._dimoverride" "_dimclre" cl "_dimclrd" cl "_dimclrt" cl "" e "")
               (if (assoc 340 l)
                  (progn
                     (setq l2 (entget (setq e2 (cdr (assoc 340 l)))))
                     (if (assoc 62 l2)
                        (progn (entmod (subst (cons 62 cl) (assoc 62 l2) l2))(entupd e2))
                        (progn (entmod (append l2 (list (cons 62 cl))))(entupd e2))
                     )
                  )
               )
            )
            ((= (cdr (assoc 0 l)) "MULTILEADER")
               (if (assoc 62 l)
                  (progn (entmod (subst (cons 62 cl) (assoc 62 l) l))(entupd e))
                  (progn (entmod (append l (list (cons 62 cl))))(entupd e))
               )
               (setq o  (vlax-ename->vla-object e)
                     co (vla-get-leaderlinecolor o)
                     tx (vla-get-textstring o)
               )
               (vla-put-colorindex co cl)
               (vla-put-leaderlinecolor o co)
               (while (wcmatch tx "*\\C*;*")
                  (setq n 0)
                  (repeat 257
                     (setq tx (vl-string-subst "" (strcat "\\C" (itoa n) ";") tx)
                            n (1+ n)
                     )
                  )
               )
               (vla-put-textstring o
                   (strcat "\\C" (itoa cl) ";" tx)
               )
               
            )
         )
      )
   )
   (command "._Undo" "_End")
   (princ)
)

 

Edited May 11 by SLW210
Added Code Tags!!

[SLW210]

Please use Code Tags for your Codes!! (<> in the editor toolbar)

[Steven P]

3 hours ago, Ashishs said:

 

 

Below is the LSP I am using, which is not working on this text. Please let me know if anything is missing.

 

Is the text text or mtext rather than a part of a dimension, leader or qleader?

[SLW210]

The routine I linked  back to was the one for texts/mtexts, why wouldn't you use that one?

[Ashishs]

14 hours ago, SLW210 said:

The routine I linked  back to was the one for texts/mtexts, why wouldn't you use that one?

Can't we combine both the routines so that with a single command any type of dimension (leader, qleader) and any type of text (text, mtext) changes to the specified color?

[Steven P]

That is possible - a great learning opportunity... have a go and come back with any questions maybe?

[SLW210]

For what it's worth, I may have something that does it all, like stated, you need to give it a try. You seem pretty demanding and wanting all kinds of options, not mentioned originally.

 

I'm not that smart, but I learned to tweak a LISP a long time ago.

 

Also, it's easy enough to make each LISP a shortcut, so simply load both LISPs and type one shortcut for DimText and the other for the rest.

[SLW210]

On 11/26/2024 at 3:09 PM, pkenewell said:

@Ashishs

OK. Multileaders are a bit harder. With the code below. I can set the leader line color different than the Mleaderstyle, but I don't know how to change the implicit color of the text (also set in the Mleaderstyle), other than to put a color formatting code into the text content. If someone else knows how to change the Text color outside of the Mleaderstyle, then I welcome their input. 

On 11/26/2024 at 3:09 PM, pkenewell said:

FWIW - with Mleaders, you could create a style that is all RED, then easily use properties to change the Mleader style.

 

@pkenewell

I found this a while back and have it in my Change Color of Text LISP

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/multileader-text-color/m-p/7424985#M359595

 

[SLW210]

This only changes the color of the TEXT/MText, DimText, MLeaders Text, etc., not any leaders or dim lines, extension lines, etc.

 

P.S. IIRC, it doesn't do Attributes.

 

;;; Change color of Text (Text, MText, DimText,Leader Text, MLeader Text)
;;;
;;; By SLW210 (a.k.a. Steve Wilson)
;;;
;;;***********************************************************************************************************|
;;; Thanks to: DannyNL                                                                                        |
;;; Change Color of Multileader Text                                                                          |
;;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/multileader-text-color/m-p/7424985#M359595|
;;;                                                                                                           |
;;;  Also for the index choice dialog box idea                                                                |
;;;                                                                                                           |
;;;***********************************************************************************************************|
;;;


(vl-load-com)

(defun c:CCT (/ ss color i ent obj entType newColorStr txt curColor dimOverrides)

  ;; Prompt for selection
  (prompt "\nSelect TEXT, MTEXT, DIMENSION, MULTILEADER, or LEADER entities: ")
  (setq ss (ssget '((0 . "TEXT,MTEXT,DIMENSION,MULTILEADER,LEADER"))))

  ;; If something is selected
  (if ss
    (progn
      ;; Color picker dialog
      (setq color (acad_colordlg 1 nil))
      (if color
        (progn
          (setq newColorStr (strcat "\\C" (itoa color))) ; e.g., \C1

          (setq i 0)
          (while (< i (sslength ss))
            (setq ent (ssname ss i))
            (setq obj (vlax-ename->vla-object ent))
            (setq entType (vlax-get obj 'ObjectName))

            (cond
              ;; TEXT, MTEXT, LEADER
              ((member entType '("AcDbText" "AcDbMText" "AcDbLeader"))
               (vla-put-Color obj color)
              )

              ;; DIMENSION types (all subclasses included)
              ((wcmatch entType "AcDb*Dimension*")
               (progn
                 ;; Set direct text color
                 (if (vlax-property-available-p obj 'TextColor)
                   (vla-put-TextColor obj color)
                 )
                 ;; Apply via style override too, for full compatibility
                 (if (vlax-property-available-p obj 'DimensionStyleOverrides)
                   (progn
                     (setq dimOverrides (vla-get-DimensionStyleOverrides obj))
                     (if (vlax-property-available-p dimOverrides 'TextColor)
                       (vla-put-TextColor dimOverrides color)
                     )
                   )
                 )
               )
              )

              ;; MULTILEADER 
              ((eq entType "AcDbMLeader")
               (if (and (vlax-property-available-p obj 'TextString)
                        (setq txt (vla-get-TextString obj))
                        (stringp txt)
                   )
                 (progn
                   (if (and txt (wcmatch txt "*\\C*,*"))
                     (progn
                       (setq curColor (RegEx "\\\\C\\d+" txt))
                       (if curColor
                         (setq txt (vl-string-subst newColorStr curColor txt))
                         (setq txt (strcat "{" newColorStr ";" txt "}"))
                       )
                     )
                     (setq txt (strcat "{" newColorStr ";" txt "}"))
                   )
                   (vla-put-TextString obj txt)
                 )
                 (prompt "\nSkipping MLeader without valid text.")
               )
              )

              (T
               (prompt (strcat "\nSkipped unknown or unsupported object: " entType))
              )
            )

            (setq i (1+ i))
          )
          (princ "\nText color updated.")
        )
        (prompt "\nColor selection cancelled.")
      )
    )
    (prompt "\nNo objects selected.")
  )

  (princ)
)

;; Regex helper to extract color code
(defun RegEx (RE_Pattern RE_SearchString / RE_RegExObject RE_Result RE_Return)
  (if (and (stringp RE_SearchString) (stringp RE_Pattern))
    (progn
      (setq RE_RegExObject (vlax-get-or-create-object "VBScript.RegExp"))
      (vlax-put-property RE_RegExObject 'Pattern RE_Pattern)
      (setq RE_Result (vl-catch-all-apply 'vlax-invoke-method (list RE_RegExObject 'Execute RE_SearchString)))
      (if (and (not (vl-catch-all-error-p RE_Result)) (> (vla-get-Count RE_Result) 0))
        (setq RE_Return (vla-get-Value (vlax-get-property RE_Result 'Item 0)))
      )
      (vlax-release-object RE_RegExObject)
    )
  )
  RE_Return
)