Modified to include Blocks and Mtext.
;|-------------------=={ Auto Align Text to Curve }==-------------------
Prompts the user for a selection of single-line Text objects and a
curve for the alignment; rotates each text item to align with the
tangent vector at the nearest point on the curve.
----------------------------------------------------------------------
Author: Lee Mac, Copyright © 2013 - www.lee-mac.com
http://www.theswamp.org/index.php?topic=54837.0
----------------------------------------------------------------------
(load "Auto Align Text to Curve.lsp") atc |;
(defun c:atc ( / *error* ent enx idx sel )
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(if
(and (setq sel (LM:ssget "\nSelect Text: " '("_:L" ((0 . "*TEXT,INSERT")))))
(progn
(while
(progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect Curve: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type ent))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ent)))
(princ "\nInvalid object selected.")
)
)
)
)
)
(= 'ename (type ent))
)
)
(progn
(LM:startundo (LM:acdoc))
(repeat (setq idx (sslength sel))
(setq enx (entget (ssname sel (setq idx (1- idx)))))
(entmod
(subst
(cons 50
(LM:readable
(angle '(0.0 0.0 0.0)
(trans
(vlax-curve-getfirstderiv ent
(vlax-curve-getparamatpoint ent
(vlax-curve-getclosestpointto ent
(trans
(cdr
(assoc
(if
(or
(= (cdr(assoc 0 enx)) "INSERT")
(= (cdr(assoc 0 enx)) "MTEXT")
(and
(zerop (cdr (assoc 72 enx)))
(zerop (cdr (assoc 73 enx)))
)
)
10 11
)
enx
)
)
(cdr (assoc -1 enx)) 0
)
)
)
)
0 (cdr (assoc -1 enx))
)
)
)
)
(assoc 50 enx) enx
)
)
)
(LM:endundo (LM:acdoc))
)
)
(command "_.justifytext" sel "" "MC")
(princ)
)
;; Readable - Lee Mac
;; Returns an angle corrected for text readability.
(defun LM:readable ( a )
( (lambda ( a )
(if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
(LM:readable (+ a pi))
a
)
)
(rem (+ a pi pi) (+ pi pi))
)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
(defun LM:ssget ( msg params / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget params))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;