QUICK LISP FOR CHANGING MTEXT JUSTIFICATION (V21)

OPAdrafting

The onboard express tools for rejustifying text wouldn't work on mid-centre Mtext for me. I wrote a quick set of LISPs to do Mid-left, Mid-right, Mid-top, Mid-bottom. commands are MLJUST, MRJUST, TCJUST, BCJUST:





(defun c:MLJUST ( / MLENTITY MLGETDXF MLOLDJUST MLNEWJUST MLCHANGEJUST) ;;ML prefix was used during writing, it's not necessary


(setq MLENTITY (car (entsel))
MLGETDXF (ENTGET MLENTITY)
MLOLDJUST (ASSOC 71 MLGETDXF)
MLNEWJUST '(71 . 4)
MLGETDXF (SUBST MLNEWJUST MLOLDJUST MLGETDXF)
)

(ENTMOD MLGETDXF)

)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun c:MRJUST ( / ENTITY GETDXF OLDJUST NEWJUST CHANGEJUST)


(setq ENTITY (car (entsel))
GETDXF (ENTGET ENTITY)
OLDJUST (ASSOC 71 GETDXF)
NEWJUST '(71 . 6)
GETDXF (SUBST NEWJUST OLDJUST GETDXF)
)

(ENTMOD GETDXF)

)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun c:TCJUST ( / ENTITY GETDXF OLDJUST NEWJUST CHANGEJUST)


(setq ENTITY (car (entsel))
GETDXF (ENTGET ENTITY)
OLDJUST (ASSOC 71 GETDXF)
NEWJUST '(71 . 2)
GETDXF (SUBST NEWJUST OLDJUST GETDXF)
)

(ENTMOD GETDXF)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun c:BCJUST ( / ENTITY GETDXF OLDJUST NEWJUST CHANGEJUST)


(setq ENTITY (car (entsel))
GETDXF (ENTGET ENTITY)
OLDJUST (ASSOC 71 GETDXF)
NEWJUST '(71 . 8)
GETDXF (SUBST NEWJUST OLDJUST GETDXF)
)

(ENTMOD GETDXF)

)




You can change NEWJUST '(71 . X) for the correct justification according to the dxf tag table if there's more you needed.

vinceaman

OPA... Thanks for sharing!

Here's how I would do this...

Define a sub-function, since you are using the same code in each function
Create Command Function "aliases" which call the sub function with your assoc value and a Message, which makes it easier to add more variations and options.

Verify an object was selected and it's Mtext, since changing dxf 71 on Text, flips it upside-down and backwards

The (princ) and the end of the command function clears the "nil" after the program is finished...

;
;
(defun c:BCJ () (myjust 8 "Bottom Centered..." )(princ))
(defun c:MLJ () (myjust 4 "Middle Left..." )(princ))
(defun c:MRJ () (myjust 6 "Middle Right..." )(princ))
(defun c:TCJ () (myjust 2 "Top Center..." )(princ))

(defun myjust ( new71 message / ent newM)

(setq ent (car (entsel "\n: Select Mtext:")))
(if ent ; check to make sure an ent was picked
(progn
(setq getDxf (entget ent))
(if (equal (cdr (assoc 0 getDxf)) "MTEXT") ; verify it's an Mtext
(progn
(entmod (subst (cons 71 new71) (assoc 71 getDxf) getDxf))
(princ (strcat "\n\n: " message))
)
(princ "\n\n: Not MText?? " )
) ; if Mtext
) ; if ent
)
)
;
;

BTW.... Just noticed when posting, all the prefix spaces in each line are removed... ugh! I was wondering why your code was all left justified!

vinceaman

My attempt at making Lisp easier to read in the Post, since the extra spaces are being removed... :-)

;
;
(defun c:BCJ () (myjust 8 "Bottom Centered..." )(princ))
(defun c:MLJ () (myjust 4 "Middle Left..." )(princ))
(defun c:MRJ () (myjust 6 "Middle Right..." )(princ))
(defun c:TCJ () (myjust 2 "Top Center..." )(princ))

(defun myjust ( new71 message / ent newM)

... (setq ent (car (entsel "\n: Select Mtext:")))
... (if ent ; check to make sure an ent was picked
... ... (progn
... ... ... (setq getDxf (entget ent))
... ... ... (if (equal (cdr (assoc 0 getDxf)) "MTEXT") ; verify it's an Mtext
... ... ... ... (progn
... ... ... ... ... (entmod (subst (cons 71 new71) (assoc 71 getDxf) getDxf))
... ... ... ... ... (princ (strcat "\n\n: " message))
... ... ... ... )
... ... ... ... (princ "\n\n: Not MText?? " )
... ... ... ) ; if Mtext
... ... ) ; if ent progn
... )

)

OPAdrafting

Thanks guys.

When I wrote it I just cut-pasted from the first example and renamed the entire function for each justification. I thought posting it that way would be easiest to allow entry level amendments without having to read through nested reference functions.

Anyway, I hope this little tool helps someone somewhere, I hate encountering issues with things that should work but don't, and there's no explanation other than "It does work" or "Yeah, known issue...."

GL