This is some code from Mark with some small improvements by me:
(defun c:AlignText (/
; local functions
getSegment get-opp-ang undobegin undoend
; local variables
ent txt_ent obj txt_obj obj_typ ang ans SS
)
;;; FUNCTION
;;; rotates the user selected (M)TEXT to the user selected
;;; entity. valid entites are light weight plines, lines
;;; and (m)text. you are given the chance to rotate the
;;; by 180 degrees after intial rotation.
;;;
;;; ARGUMENTS
;;; none
;;;
;;; PLATFORMS
;;; 2000+
;;;
;;; AUTHOR
;;; Copyright© 2004 Mark S. Thomas
;;; mark_AT_theswamp.org
;;;
;;; VERSION
;;; 1.0 Tue Dec 07, 2004
;;; 1.1 Tue Dec 21, 2004 ; added ARC types
;;; 1.1a Tue Dec 21, 2004 ; reversed the pick order
;;; 1.2 Wen Feb 8, 2006 ; Improved 'Dynamic Input' (by J.J.Damstra)
;;; 1.3 Wen Feb 15, 2006 ; Use TORIENT to rotate te text (if possible)
;;; 1.4 Wen Feb 15, 2006 ; A previous selection is now possible
;;;
;;; TODO:
;;; handle text that has 'fit' justification
;;; add more entites for angle extraction (MLINES !)
;;; more testing
(vl-load-com)
;; credit Stig Madsen
;; refer to thread titled "relaxed-curves" under the "Teach Me"
;; section of TheSwamp at www.theswamp.org/phpBB2/
(defun getSegment (obj pt / cpt eParam stParam)
(cond ((setq cpt (vlax-curve-getClosestPointTo obj pt))
(setq eParam (fix (vlax-curve-getEndParam obj)))
(if (= eParam (setq stParam (fix (vlax-curve-getParamAtPoint obj cpt))))
(setq stParam (1- stParam))
(setq eParam (1+ stParam))
)
(list eParam (vlax-curve-getPointAtParam obj stParam)
(vlax-curve-getPointAtParam obj eParam))
)
)
)
;; undo functions
(defun undobegin ()
(vla-EndUndoMark
(vlax-get-property
(vlax-get-acad-object)
'ActiveDocument
)
)
(vla-StartUndoMark
(vlax-get-property
(vlax-get-acad-object)
'ActiveDocument
)
)
)
(defun undoend ()
(vla-EndUndoMark
(vlax-get-property
(vlax-get-acad-object)
'ActiveDocument
)
)
)
;; returns the oppsite of an angle define in radians
(defun get-opp-ang (ang)
(cond ((< ang pi)(+ ang pi))
((> ang pi)(- ang pi))
((equal ang pi) 0.0)
((equal ang 0.0) pi)
)
)
;; ================= body of main function starts here ======================
;; ----------- Get the Text to Align -----------------
(cond
((setq txt_ent (car (entsel "\nSelect text to align")))
(setq txt_obj (vlax-ename->vla-object txt_ent)
obj_typ (vlax-get-property txt_obj 'ObjectName)
)
(cond
((or (= obj_typ "AcDbMText") (= obj_typ "AcDbText")))
(T
(setq txt_ent nil)
(alert "Ik kan alleen maar (M)TEXT 'alignen'."))
)
)
)
;; ----------- Get the Object to Align To -----------------
(cond
((and txt_ent
(setq ent (entsel "\nSelect entity for alignment: ")))
(setq obj (vlax-ename->vla-object (car ent))
obj_typ (vlax-get-property obj 'ObjectName)
)
(cond
((= obj_typ "AcDbPolyline")
(if (setq pt_lst (getSegment obj (last ent)))
(setq ang (angle (cadr pt_lst)(caddr pt_lst)))
)
)
((= obj_typ "AcDbLine")
(setq ang (vlax-get-property obj 'Angle))
)
((= obj_typ "AcDbText")
(setq ang (vlax-get-property obj 'Rotation))
)
((= obj_typ "AcDbMText")
(setq ang (vlax-get-property obj 'Rotation))
)
((= obj_typ "AcDbArc")
(setq ang (angle
(vlax-safearray->list
(vlax-variant-value
(vla-get-StartPoint obj)))
(vlax-safearray->list
(vlax-variant-value
(vla-get-EndPoint obj)))
)
)
)
(T (alert "That's not an entity I deal with"))
)
)
)
;; ----------- Align the Text -----------------
(cond
((null ang)) ; do nothing
((null txt_ent)) ; do nothing
(T
(undobegin)
(vlax-put-property txt_obj 'Rotation ang)
(if (not bns_trot)(if (findfile "acettxt.lsp")(load "acettxt")))
(if bns_trot
(progn
; TORIENT gebruiken om de tekst te draaien:
(setq SS (ssadd (vlax-vla-object->ename txt_obj)))
(bns_trot SS nil)
)
(progn
(initget 0 "Ja Nee")
(setq ans (getkword "\nTekst 180 graden draaien? [Ja/Nee] <Nee> "))
(if (= ans "Ja")(vlax-put-property txt_obj 'Rotation (get-opp-ang ang)))
)
)
; Om met previous de tekst opnieuw te kunnen selecteren:
(command "._select" (vlax-vla-object->ename txt_obj) "")
(vlax-release-object txt_obj)
(undoend)
)
)
(princ)
)
