CAD Posted September 20, 2017 Share Posted September 20, 2017 Hello, Is there a lisp that could change mtext instant bylayer, without selection (in en outside blocks), with command mBylayer:roll: Quote Link to comment Share on other sites More sharing options...
ronjonp Posted September 20, 2017 Share Posted September 20, 2017 Are you sure the color is not caused by internal formatting of the mtext? (1 . "{\\C1;foo}") HERE is some code to change all objects to color bylayer. Quote Link to comment Share on other sites More sharing options...
CAD Posted September 20, 2017 Author Share Posted September 20, 2017 Hello Ronjonp, dont know formating but when u double click mtext u can change the color or bylayer. but with properties u can change bylayer but it wont change the color. so i want internal of the mtext bylayer. the HERE I only need mtext to be bylayer not all object of the drawing. but thx for replying Quote Link to comment Share on other sites More sharing options...
ronjonp Posted September 20, 2017 Share Posted September 20, 2017 Hello Ronjonp, I only need mtext to be bylayer not all object of the drawing. but thx for replying Grab the code I linked to and replace the _objecttobylayer function with this: (defun _objecttobylayer (obj / layer) (cond ((eq "AcDbMText" (vlax-get obj 'objectname)) (vl-catch-all-apply 'vlax-put (list obj 'color 256)) ) ) ) Quote Link to comment Share on other sites More sharing options...
CAD Posted September 20, 2017 Author Share Posted September 20, 2017 huh nothing happen? Quote Link to comment Share on other sites More sharing options...
ronjonp Posted September 20, 2017 Share Posted September 20, 2017 huh nothing happen? Grab THIS code and replace the _objecttobylayer function with the code above? Quote Link to comment Share on other sites More sharing options...
CAD Posted September 20, 2017 Author Share Posted September 20, 2017 (edited) Is there not a smaller lisp only for Mtext. this lisp is a risk to my drawing with a wrong move. have replace but think i doing it wrong (defun c:DrawingToByLayer ;;----------------------------------------------------------------- ;; ;; Copyright © 2004 Michael Puckett. All Rights Reserved ;; ;;----------------------------------------------------------------- ;; ;; Forces the entire drawing to "ByLayer" (even xrefs for ;; the lifetime of the session or until an xref reload ;; occurs). ;; ;; Forces block definition child entities to layer "0". ;; ;; Existing attributes are forced to the same layer the ;; parent block reside on. ;; ;; Nominally tested, let me know if you find anything wonky. ;; ;; * Use at your own risk. Please test on a dummy dwg * ;; ;;----------------------------------------------------------------- ( / _UnLockAllLayers _LockLayers _ObjectToLayerZero _ObjectToByLayer _DocumentToByLayer _Main ) (defun _UnLockAllLayers ( document / result ) (vlax-for layer (vlax-get-property document 'Layers ) (cond ( (eq :vlax-true (vlax-get-property layer 'Lock ) ) (vlax-put-property layer 'Lock :vlax-false ) (setq result (cons layer result ) ) ) ) ) result ) (defun _LockLayers ( layers ) (foreach layer layers (vlax-put-property layer 'Lock :vlax-true ) ) ) (defun _ObjectToLayerZero ( object ) (vlax-put-property object 'Layer "0" ) ) (defun _objecttobylayer (obj / layer) (cond ((eq "AcDbMText" (vlax-get obj 'objectname)) (vl-catch-all-apply 'vlax-put (list obj 'color 256)) ) ) ) (cond ( (and (eq "AcDbBlockReference" (vlax-get obj 'ObjectName ) ) (eq :vlax-true (vlax-get-property obj 'HasAttributes ) ) ) (setq layer (vlax-get-property obj 'Layer)) (foreach child (vlax-invoke obj 'GetAttributes) (_ObjectToByLayer child) (vlax-put-property child 'Layer layer) ) ) ) ) (defun _DocumentToByLayer ( document ) (vlax-for block (vlax-get-property document 'Blocks) (if (eq :vlax-true (vlax-get-property block 'IsLayout ) ) (vlax-for object block (_ObjectToByLayer object) ) (vlax-for object block (_ObjectToByLayer object) (_ObjectToLayerZero object) ) ) ) ) (defun _Main ( / document lockedLayers ) (setq lockedLayers (_UnlockAllLayers (setq document (vlax-get-property (vlax-get-acad-object) 'ActiveDocument ) ) ) ) (_DocumentToByLayer document) (_LockLayers lockedLayers) (princ) ) (_Main) ) Edited September 21, 2017 by CAD Quote Link to comment Share on other sites More sharing options...
ronjonp Posted September 20, 2017 Share Posted September 20, 2017 (edited) (defun c:drawingtobylayer ;;----------------------------------------------------------------- ;; ;; Copyright © 2004 Michael Puckett. All Rights Reserved ;; ;;----------------------------------------------------------------- ;; ;; Forces the entire drawing to "ByLayer" (even xrefs for ;; the lifetime of the session or until an xref reload ;; occurs). ;; ;; Forces block definition child entities to layer "0". ;; ;; Existing attributes are forced to the same layer the ;; parent block reside on. ;; ;; Nominally tested, let me know if you find anything wonky. ;; ;; * Use at your own risk. Please test on a dummy dwg * ;; ;;----------------------------------------------------------------- (/ _unlockalllayers _locklayers _objecttolayerzero _objecttobylayer _documenttobylayer _main) (defun _unlockalllayers (document / result) (vlax-for layer (vlax-get-property document 'layers) (cond ((eq :vlax-true (vlax-get-property layer 'lock)) (vlax-put-property layer 'lock :vlax-false) (setq result (cons layer result)) ) ) ) result ) (defun _locklayers (layers) (foreach layer layers (vlax-put-property layer 'lock :vlax-true))) ;; (defun _objecttolayerzero (object) (vlax-put-property object 'layer "0")) (defun _objecttobylayer (obj / layer) (cond ((eq "AcDbMText" (vlax-get obj 'objectname)) (vl-catch-all-apply 'vlax-put (list obj 'color 256)) (vl-catch-all-apply 'vlax-put (list obj 'textstring (lm:unformat (vla-get-textstring obj) t)) ) ) ) ) (defun _documenttobylayer (document) (vlax-for block (vlax-get-property document 'blocks) (if (eq :vlax-true (vlax-get-property block 'islayout)) (vlax-for object block (_objecttobylayer object)) (vlax-for object block (_objecttobylayer object)) ) ) ) (defun _main (/ document lockedlayers) (setq lockedlayers (_unlockalllayers (setq document (vlax-get-property (vlax-get-acad-object) 'activedocument)) ) ) (_documenttobylayer document) (_locklayers lockedlayers) (princ) ) (_main) ) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun lm:unformat (str mtx / _replace rx) (defun _replace (new old str) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda () (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '(("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]" ) ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str) ) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) (vl-load-com) Edited September 20, 2017 by ronjonp Quote Link to comment Share on other sites More sharing options...
CAD Posted September 20, 2017 Author Share Posted September 20, 2017 Nope nothing happen with my mtext still is color not bylayer internal. Quote Link to comment Share on other sites More sharing options...
ronjonp Posted September 20, 2017 Share Posted September 20, 2017 Post your drawing. Quote Link to comment Share on other sites More sharing options...
CAD Posted September 20, 2017 Author Share Posted September 20, 2017 Post your drawing. see atachment test.dwg Quote Link to comment Share on other sites More sharing options...
ronjonp Posted September 20, 2017 Share Posted September 20, 2017 As I suspected the color is hard coded into the mtext object. You should read my first post more closely, that was my initial question. (1 . "{\\C244;\\c1973145;safsaf}") You'll need something like Lee's unformat function to clean this up. Try the code posted HERE again. Quote Link to comment Share on other sites More sharing options...
SLW210 Posted September 21, 2017 Share Posted September 21, 2017 CAD, Please read the Code Posting Guidelines and edit your Code to be included in Code Tags.[NOPARSE] Your Code Here[/NOPARSE] = Your Code Here Quote Link to comment Share on other sites More sharing options...
CAD Posted September 21, 2017 Author Share Posted September 21, 2017 Hello Ronjonp, i have try Lee mac lisp and load it, but when i type unformat nothing happen? ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun LM:UnFormat ( str mtx / _replace rx ) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) (vl-load-com) Quote Link to comment Share on other sites More sharing options...
ronjonp Posted September 21, 2017 Share Posted September 21, 2017 Please read my last post more closely. Quote Link to comment Share on other sites More sharing options...
CAD Posted September 21, 2017 Author Share Posted September 21, 2017 Dont know what u mean thx alot Quote Link to comment Share on other sites More sharing options...
ronjonp Posted September 21, 2017 Share Posted September 21, 2017 Dont know what u mean thx alot USE THIS CODE... Quote Link to comment Share on other sites More sharing options...
CAD Posted September 24, 2017 Author Share Posted September 24, 2017 thankyou it does work thxxxxxx for ur helpp:notworthy::) you the best!! Quote Link to comment Share on other sites More sharing options...
ronjonp Posted September 26, 2017 Share Posted September 26, 2017 Glad we got it sorted Quote Link to comment Share on other sites More sharing options...
CAD Posted September 26, 2017 Author Share Posted September 26, 2017 Glad we got it sorted Without your guys, it make my life much easier !!! glad u guys are soo SMART, and make it happen. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.