Align Text

(defun c:rrt (/
               ; local functions
               getSegment get-opp-ang undobegin undoend
               ; local variables
               ent txt_ent obj txt_obj obj_typ ang ans
               )

  ;;; 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
  ;;;
  ;;; USAGE
  ;;; enter RRT on the comand line
  ;;;
  ;;; 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
  ;;;
  ;;; TODO:
  ;;; handle text that has 'fit' justification
  ;;; add more entites for angle extraction
  ;;; 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 "I only know how to align (M)TEXT, sorry! "))
      )
    )
  )
 
  ;;  -----------   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)
      (setq ans (getstring "\nRotate 180 [Y/N]<N>: "))
      (if (= (strcase ans) "Y")
        (vlax-put-property txt_obj 'Rotation (get-opp-ang ang))
        )
      (vlax-release-object txt_obj)
      (undoend)
     )
   )
  (princ)
)  Logged