I hate doing things I can make my computer do for me. My adventures in customizing and automating computers. Primarily with AutoCAD and Microsoft Office.

Monday, August 27, 2012

Here are some Text Justification Routines using a core routine.

This link to Justify_Text_Tools.lsp (originally by Ryan Pace) has routines for setting the justification of text/mtext objects.  The included routines are:
(defun c:JTL () (JustifyText "TL")(princ));Justify Text to top left
(defun c:JTR () (JustifyText "TR")(princ));Justify Text to top right
(defun c:JTC () (JustifyText "TC")(princ));Justify Text to top center
(defun c:JML () (JustifyText "ML")(princ));Justify Text to middle left
(defun c:JMR () (JustifyText "MR")(princ));Justify Text to middle right
(defun c:JMC () (JustifyText "MC")(princ));Justify Text to middle center
(defun c:JBL () (JustifyText "BL")(princ));Justify Text to bottom left
(defun c:JBR () (JustifyText "BR")(princ));Justify Text to bottom right
(defun c:JBC () (JustifyText "BC")(princ));Justify Text to bottom center
As you can see, each of the routines calls the JustifyText routine with an argument telling it which justification to use.  This allows us to use the one core routine for multiple tools so if we ever have to update the routines we only have to update the JustifyText sub-routine.
(defun JustifyText(mode / *ERROR* cmdecho)
  (defun *ERROR*(msg)
    (command)
    (command)
    (command)
    (if cmdecho (setvar "cmdecho" cmdecho))
    (princ msg)
  )
  (setq cmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (cond
    ((null (setq ss1 (vl-catch-all-apply 'ssget (list '((0 . "Text,Mtext,Attdef"))))))
      nil
    )
    ((vl-catch-all-error-p ss1)
      (princ (strcat "\nERROR|" (vl-catch-all-error-message ss1)))
      nil
    )
    ((and
        (= 'PICKSET (type ss1))
        (= 0 (sslength ss1))
      )
      nil
    )
    (T(command "_justifytext" ss1 "" mode))
  )
  (setvar "cmdecho" cmdecho)
  ss1
)

No comments: