Changing MText Text color inside block

December 5, 2022

Hi everyone.

I'm trying to improve routine to cleanup a drawing by changing everything to bylayer. My code so far is an improvised version from other code i found as I'm not a coder at all.

The code so far works fine, until there are mtext or mleader OUTSIDE OR INSIDE BLOCK OR NESTED BLOCK with text set to anything other than bylayer. basically this text parameter cannot be changed by my current code.

I found some solution mentioned in other post like the stripmtext and the stpmtext, both are great but not working with mtext within block. And if possible, i want a one stop routine for cleaning the drawing.

I tried to incorporate the stpmtext code into my routine but after spending around the whole week last week, I just could not understand almost the whole stpmtext routine.

Below are my current code to cleanup my drawing:

;;  CleanupDrawingto8.lsp [command name: CLEANUP] 
;;  To change all entities including all entities, all Block definitions in the drawing, including
;;  all nested Block definitions [but not Xrefs] and Dimension/Leader
;;  parts, to color ByLayer and all Layer to Color Code input by user.
;;  Azri, 23 May 2022 (modified from p_mcknight code)
;; 1.1 	- 	add user input for layer color, fix leader and dimension inside block not working, add info prompt 
;; 			and closing prompt.

(vl-load-com)
(setq *doc* (vla-get-activedocument (vlax-get-acad-object)))

(defun c:cleanup ( / obj vlobj mainBlock childEnt vlobj num)

  ;Start with regular entities
  (setq obj (entnext))
  (while obj
    (setq vlobj (vlax-ename->vla-object obj))
    (vla-put-color vlobj 256) ;color bylayer
	(if (wcmatch (vla-get-ObjectName vlobj) "*Dimension,*Leader")
      (foreach prop '(DimensionLineColor ExtensionLineColor TextColor)
        ;; not all such entity types have all 3 properties, but all have at least one
        (if (vlax-property-available-p vlobj prop)
          (vlax-put vlobj prop 256); ByLayer
        ); if
      ); foreach
    ); if
    (setq obj (entnext obj))

    )


  ;Process entities within blocks
  (setq mainBlock (tblnext "block" t))
  (while mainBlock
    (setq childEnt (cdr (assoc -2 mainBlock)))
    (while childEnt
      (setq vlobj (vlax-ename->vla-object childEnt))
      (vla-put-color vlobj 256)
	(if (wcmatch (vla-get-ObjectName vlobj) "*Dimension,*Leader")
      (foreach prop '(DimensionLineColor ExtensionLineColor TextColor)
        ;; not all such entity types have all 3 properties, but all have at least one
        (if (vlax-property-available-p vlobj prop)
          (vlax-put vlobj prop 256); ByLayer
        ); if
      ); foreach
    ); if
      (setq childEnt (entnext childEnt))
      );end while
    (setq mainBlock (tblnext "block"))
    )
  
  (setq num (getint "\nEnter color code for all layers:"))
  (command "_.layer" "_color" num "*" "")
  (command ".regen")
  (prompt "\n--> Cleanup Process Completed <--")
  (prompt "\n--> Retype CLEANUP to change all layers color again <--")
  (princ)  
  ) ; defun
  
  (prompt "\n--> Type CLEANUP to start.")
  (princ)

Many thanks for everyone input.

ps: i attached below sample dwg for routine testing.

regards,

Azri

sample.dwg

December 5, 2022

Lee Mac's UnFormat String should work better for calling from your code.

I was able to do it with just StripMtext and AutoCAD's SETBYLAYER (Command) but navigating all those nested blocks was a pain.

December 6, 2022

14 hours ago, tombu said:

Lee Mac's UnFormat String should work better for calling from your code.

I was able to do it with just StripMtext and AutoCAD's SETBYLAYER (Command) but navigating all those nested blocks was a pain.

Thank you. If i understand this correctly, i need to put this function inside my code, run a loop to get all mtext and mleader text string, pass it into this function and return back as textstring to the mtext and mleader?

December 6, 2022

It's finally working! Its just case of not understanding coding

Final code below able to cleanup all element to bylayer. I couldnt find credit for stripstring routine. If anyone found it, please inform me so that i can properly quote them.

Thank you for @tombufor the insight leading to the solution.

;;  CleanupDrawingto8.lsp [command name: CLEANUP] 
;;  To change all entities including all entities, all Block definitions in the drawing, including
;;  all nested Block definitions [but not Xrefs] and Dimension/Leader
;;  parts, to color ByLayer and all Layer to Color Code input by user.
;;  Azri, 23 May 2022 (modified from p_mcknight code)
;; 1.1 	- 	add user input for layer color, fix leader and dimension inside block not working, add info prompt 
;; 			and closing prompt.
; 1.2 (2022-12-06) - add support for mtext and mleader outside and inside block.

(vl-load-com)
(setq *doc* (vla-get-activedocument (vlax-get-acad-object)))

(defun c:cleanup ( / obj vlobj mainBlock childEnt vlobj num ss ent1 ent2 tstr1 tstr2)

  ;Start with regular entities=============================//
  (setq obj (entnext))
  (while obj
    (setq vlobj (vlax-ename->vla-object obj))
    (vla-put-color vlobj 256) ;color bylayer
	
      (if (wcmatch (vla-get-ObjectName vlobj) "*Dimension,*Leader")
       (foreach prop '(DimensionLineColor ExtensionLineColor TextColor)
        ;; not all such entity types have all 3 properties, but all have at least one
        (if (vlax-property-available-p vlobj prop)
          (vlax-put vlobj prop 256); ByLayer
        ); if
       ); foreach
      ); if
	  
		(if (wcmatch (vla-get-ObjectName vlobj) "*MLeader,*MText")
			(foreach prop '(TextString)
					(setq tstr1 (vlax-get vlobj 'TextString))
					(setq tstr2 (StripString tstr1))
					(vlax-put vlobj 'TextString tstr2)					
			); foreach
		); if
	  
     (setq obj (entnext obj))
    );setq
		

  ;Process entities within blocks=================================//
  (setq mainBlock (tblnext "block" t))
  (while mainBlock
    (setq childEnt (cdr (assoc -2 mainBlock)))
		(while childEnt
			
			(setq vlobj (vlax-ename->vla-object childEnt))
			(vla-put-color vlobj 256)
			
			(if (wcmatch (vla-get-ObjectName vlobj) "*Dimension,*Leader")
				(foreach prop '(DimensionLineColor ExtensionLineColor TextColor)
				;; not all such entity types have all 3 properties, but all have at least one
					(if (vlax-property-available-p vlobj prop)
						(vlax-put vlobj prop 256); ByLayer
					); if
				); foreach

			); if

			(if (wcmatch (vla-get-ObjectName vlobj) "*MLeader,*MText")
				(foreach prop '(TextString)
						(setq tstr1 (vlax-get vlobj 'TextString))
						(setq tstr2 (StripString tstr1))
						(vlax-put vlobj 'TextString tstr2)
				); foreach
			); if

  			(setq childEnt (entnext childEnt))
	  	);end while
    (setq mainBlock (tblnext "block"))
    
	);while
  ;==================================///
    
  (setq num (getint "\nEnter color code for all layers:"))
  (command "_.layer" "_color" num "*" "")
  (command ".regen")
  (prompt "\n--> Cleanup Process Completed <--")
  (prompt "\n--> Retype CLEANUP to change all layers color again <--")
  (princ)  
  ) ; defun
  
;-----------------
; StripString Routine 
(defun StripString (String / cstr1 cstr2 nString cnt1 tstr1)
; Strips out formation for color, font, height and width.

(setq cnt1 1)
(while (and (setq cstr1 (substr String 1 1)) (> (strlen String) 0))
 (if (= cstr1 "\\")
  (progn
   (setq cstr2 (substr String 2 1))
   (if (member (strcase cstr2) '("C" "F" "H" "W"))
    (progn
     (while (/= (substr String cnt1 1) ";")
      (setq cnt1 (1+ cnt1))
     ); while
     (setq String (substr String (1+ cnt1) (strlen String)))
     (setq cnt1 1)
    ); progn
    (progn
     (if nString
      (setq nString (strcat nString (substr String 1 1)))
      (setq nString (substr String 1 1))
     ); if
     (setq String (substr String 2 (strlen String)))
    ); progn
   ); if
  ); progn
  (progn
   (if nString
    (setq nString (strcat nString (substr String 1 1)))
    (setq nString (substr String 1 1))
   ); if
   (setq String (substr String 2 (strlen String)))
  ); progn
 ); if
); while
(setq tstr1 (vl-string->list nString))
(if (and (not (member 92 tstr1)) (member 123 tstr1))
 (setq tstr1 (vl-remove-if '(lambda (x) (or (= x 123) (= x 125))) tstr1))
); if
(vl-list->string tstr1)
)
;--------------------------------------  


  (prompt "\n--> Type CLEANUP to start.")
  (princ)

December 6, 2022

One more thing to consider is setting the properties of block objects to Layer 0 and ByBlock instead of ByLayer.

This link shows the difference pretty well with graphic examples: https://www.cad-notes.com/layer-0-bylayer-and-byblock/

December 6, 2022

36 minutes ago, tombu said:

One more thing to consider is setting the properties of block objects to Layer 0 and ByBlock instead of ByLayer.

This link shows the difference pretty well with graphic examples: https://www.cad-notes.com/layer-0-bylayer-and-byblock/

Thank you! I will get into understand that to further improve the routine!

Sign In

Changing MText Text color inside block

Recommended Posts

MAzri

tombu

MAzri

MAzri

tombu

MAzri

Join the conversation

Tutorials

Forums

Activity