;;;--------------------AlignTxt.lsp-----------------------------
;;; Purpose: Defines 3 commands
;;;   RotTxt: Rotates a selection of TEXT/MTEXT about their insertion points
;;;   Rot180: Rotates a selection of TEXT/MTEXT 180 ºabout their insertion points
;;;   AlignTxt: Aligns a selection set of TEXT/MTEXT with a selected entity
;;;   Supports noun-verb selection for all commands
;;; Usage: AutoCAD 2000 & later versions
;;; Version: 1.2
;;; Date this file: 20 October 2004
;;; Author: Herman Mayfarth, Tekton Construction Services
;;; Modification History:
;;; 02 July 2003: Added noun-verb selection 
;;; 02 July 2003: Added Confirmation & Chance to Rotate 180° for AlignTxt 
;;; 02 July 2003: Added ROT180 Command 
;;; 20 October 2004: Converted rotation functions to Active X 
;;; Copyright Notice
;;; © 2000,2003,2004 Herman Mayfarth
;;; This program is copyrighted original work of Herman Mayfarth and is 
;;; provided under terms of license as stipulated below.
;;;
;;; Disclaimer of Warranty
;;;
;;; HERMAN MAYFARTH AND TEKTON CONSTRUCTION SERVICES PROVIDES THIS PROGRAM
;;; "AS IS" AND WITH ALL FAULTS. HERMAN MAYFARTH AND TEKTON CONSTRUCTION SERVICES
;;; SPECIFICALLY DISCLAIM ANY IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS FOR A
;;; PARTICULAR USE. HERMAN MAYFARTH AND TEKTON CONSTRUCTION SERVICES DO NOT WARRANT
;;; THAT THE OPERATION OF THIS PROGRAM WILL BE UNINTERRUPTED OR ERROR FREE.
;;; HERMAN MAYFARTH AND TEKTON CONSTRUCTION SERVICES SHALL NOT BE LIABLE FOR ANY
;;; CONSEQUENTIAL DAMAGES DUE TO THE USE OF THIS PROGRAM IN ANY FORM OR VERSION. 
;;; THE USE OF THIS PROGRAM IS ENTIRELY AT YOUR OWN RISK.
;;;
;;; Distribution 
;;;
;;; This program is distributed as shareware.
;;; You are permitted to redistribute this version of the program without fee,
;;; provided the copyright notice and disclaimer of warranty remain intact in 
;;; the redistributed program file, along with any other documentation provided.
;;; Permission to use this program is revocable at any time, at the sole discretion
;;; of the author, in case the stipulated terms of use have been abused and/or
;;; violated.
;;;
;;; License Fees
;;;
;;; This program is not free software.
;;; If you find this program useful, and continue to use it after the stated trial
;;; period, you are required to pay a license fee to the author for its continued
;;; use.
;;;
;;; The allowed trial usage period for this program is: 30 calendar days.
;;; The license fee for one single user copy of this program is: US$10.00
;;;
;;; If you continue to use the program beyond the trial period without payment of
;;; the stated license fee, you are in violation of the stipulated terms of use.
;;;
;;; Author Contact & Remission of License Fees:
;;; Kindly remit all license fees to address below:
;;;
;;; Herman Mayfarth                hmayfarth@tktn.com
;;; Tekton Construction Services   www.tktn.com
;;; 909 W. 9th St.
;;; Corona, California 92882 USA
;;; Telephone: 951.371.5713
;;; 
;;; Thank you for your continued support. 

;;;-------------------------------------------------------------
;;;global functions used by C:AlignTxt
;;-----------getsgvrt.lsp------------------------
;;  © 2000,2003 Herman Mayfarth
;;  Needs: list consisting of entity name of a LWPOLYLINE & point on entity
;;         such as returned by (entsel)
;;  Returns: 2 element list consisting of end points of the segment
;;           ordered from start to finish
;;  Uses:  mcdrs
;;----------------------------------------------
(defun getsgvrt (alist / vrtlst vert)
  (setq vrtlst (mcdrs 10 (entget (car alist)))
        vert (nth 2 (car(ssnamex(ssget(cadr alist))))))
  (cons (nth (- vert 1) vrtlst) (list(nth vert vrtlst)))
);getsgvrt

;;-----------getldrvrt.lsp------------------------
;;  © 2000 Herman Mayfarth
;;  Needs: list consisting of entity name of a LEADER & point on entity
;;         such as returned by (entsel)
;;  Returns: 2 element list consisting of end points of the segment
;;           ordered from start to finish
;;  Uses:  mcdrs
;;  Usage: Straight (unsplined) leaders only
;;----------------------------------------------
(defun getldrvrt (alist / vrtlst vert)
  (setq vrtlst (mcdrs 10 (entget (car alist)))
        vert (nth 2 (car(ssnamex(ssget(cadr alist))))))
  (cons (nth (- vert 4) vrtlst) (list(nth (- vert 3) vrtlst)))
);getldrvrt

;;;returns a list of cdrs for a given key
;;;© 2001 Herman Mayfarth
(defun mcdrs (key alist / out)
  (foreach n alist (if (eq (car n) key) (setq out (cons (cdr n) out))))
  (reverse out)
)
;;rotate TEXT/MTEXT selection by angle
(defun rottxt-to-ang (ss ang / i obj vec)
;;need the angle of UCS to process MTEXT entities
  (setq vec (getvar "UCSXDIR")
        vec (atan (cadr vec) (car vec))
  )
  (setq i 0)
  (repeat (sslength ss)
    (setq obj (vlax-ename->vla-object (ssname ss i)))
    (cond ( (= "AcDbText" (vla-get-ObjectName obj))
            (vla-put-rotation obj ang)
          )
          ( (= "AcDbMText" (vla-get-ObjectName obj))
            (vla-put-rotation obj (- ang vec))
          )
    )
    (setq i (1+ i))
  );repeat
);rottxt-to-ang
(defun rottxt-by-ang (ss rotang / i obj)
    (setq i 0)
    (repeat (sslength ss)
      (setq obj (vlax-ename->vla-object (ssname ss i)))
      (if (member (vla-get-ObjectName obj) '("AcDbText" "AcDbMText"))
        (progn
        (vla-put-rotation obj (+ rotang (vla-get-rotation obj)))
        (setq i (1+ i)))
      );if
    );repeat
);rottxt-by-ang


;;;******************************C:RotTxt***************************
;;;   © 2001,2004 Herman Mayfarth
;;;   Purpose: Rotates a selection set of TEXT about their respective
;;;   insertion points.
;;;
;;;********************************************************************
(defun C:ROTTXT ( / rotang ss1 thisdwg)
  (vl-load-com)
  (setq thisdwg (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark thisdwg)
;;get the rotation angle
   (setq rotang (getangle "Rotation Angle: "))
;;first check to see if there is a current selection set
(if (setq ss1 (cadr(ssgetfirst)))
;;process the selection set
    (progn
     (rottxt-by-ang ss1 rotang)
     (sssetfirst nil);turn off grips
    );progn
;;otherwise prompt the user to select entities
   (progn
    (princ "\nSelect Text Entities to Rotate:   ")
    (while (null ss1)
      (setq ss1 (ssget  '((-4 . "<OR")
                          (0 . "TEXT") (0 . "MTEXT")
                          (-4 . "OR>"))
                )
      )
     );while
;;and process the result
    (rottxt-by-ang ss1 rotang)
   );progn
);if
  (vla-endundomark thisdwg)
  (princ)
);defun

;;;******************************C:Rot180***************************
;;;   © 2001 Herman Mayfarth
;;;   Purpose: Rotates a selection set of TEXT 180 degrees about their 
;;;   respective insertion points.
;;;
;;;********************************************************************
(defun C:ROT180 ( / rotang ss1 thisdwg)
  (vl-load-com)
  (setq thisdwg (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark thisdwg)
;;set the rotation angle to PI
   (setq rotang PI)
;;first check to see if there is a current selection set
(if (setq ss1 (cadr(ssgetfirst)))
;;process the selection set
    (progn
     (rottxt-by-ang ss1 rotang)
     (sssetfirst nil);turn off grips
    );progn
;;otherwise prompt the user to select entities
   (progn
    (princ "\nSelect Text Entities to Rotate 180 Degrees:   ")
    (while (null ss1)
      (setq ss1 (ssget  '((-4 . "<OR")
                          (0 . "TEXT") (0 . "MTEXT")
                          (-4 . "OR>"))
                )
      )
     );while
;;and process the result
    (rottxt-by-ang ss1 rotang)
   );progn
);if
  (vla-endundomark thisdwg)
  (princ)
);defun


;;;******************************C:AlignTxt***************************
;;;   © 2001,2003,2004 Herman Mayfarth
;;;   Purpose: Aligns a selection set of TEXT/MTEXT with existing entities
;;;   Entities supported: LINE,LEADER,LWPOLYLINE,POLYLINE,MTEXT,TEXT
;;;   Supported entities may be part of a DIMENSION, but not of a block INSERT
;;;********************************************************************
(defun C:AlignTXT ( / *error*
                      alist
                      ang
                      enext
                      ent
                      endpts
                      etype
                      flag
                      head
                      hilite
                      langle
                      p1
                      p2
                      ss1
                      stypes
                      thisdwg
                      vec
                   )
  (vl-load-com)
  (setq thisdwg (vla-get-activedocument (vlax-get-acad-object)))
  (defun *error* (msg)
    (princ (strcat "\n" msg))
    (if hilite (redraw hilite 4))
    (vla-endundomark thisdwg)
  )
  (vla-startundomark thisdwg)
;;list of supported etypes for alignment
  (setq stypes '("LINE" "LEADER" "LWPOLYLINE" "MTEXT" "TEXT" "VERTEX"))
;;need the angle of UCS to process MTEXT entities
  (setq vec (getvar "UCSXDIR")
        vec (atan (cadr vec) (car vec))
  )
;;set flag until etype can be verified
  (setq flag T)
;;select one entity of supported type
  (while flag
    (while (null (setq alist (nentsel "\nSelect a Line/Polyline/Leader/Text to Align Text:"))))
    (setq ent (entget (car alist)))
    (and (member (setq etype (cdr (assoc 0 ent))) stypes)
         (or (= (length alist) 2);not embedded in an INSERT
             (= "DIMENSION" (cdr(assoc 0 (entget(car(last alist)))))))
         (or (/= etype "LEADER")(= 0 (cdr (assoc 72 ent))));straight segments
         (setq flag nil)
    );and
  );while
  (redraw (setq hilite (car alist)) 3);highlight selected entity
;;local function to calculate angle of line segment
(defun ang (p1 p2 / lang)
  (setq lang (min (angle p1 p2) (angle p2 p1)))
  (if (> lang (/ pi 2)) (+ lang pi) lang);langle 2nd quadrant
);ang
;;cond to calculate rotation angle for each etype
(cond ((equal etype "LINE")
        (setq langle (ang (cdr(assoc 10 ent)) (cdr(assoc 11 ent))))
      )
      ((equal etype "LEADER")
        (setq endpts (getldrvrt alist)
              langle (ang (car endpts) (cadr endpts))
        )
      )
      ((equal etype "LWPOLYLINE")
        (setq endpts (getsgvrt alist)
              langle (ang (car endpts) (cadr endpts))
        )
      )
      ((equal etype "MTEXT")
       (setq langle (+ vec (cdr (assoc 50 ent))))
      )
      ((equal etype "TEXT")
       (setq langle (cdr (assoc 50 ent)))
      )
      ((equal etype "VERTEX")
       (setq p1 (cdr (assoc 10 ent)))
       (setq enext (entget (entnext (cdr (assoc -1 ent)))))
       (if (= (cdr (assoc 0 enext)) "VERTEX")
              (setq p2 (cdr (assoc 10 enext)))
              (setq head
                (entget (cdr (assoc -2 (entget (entnext (cdr (assoc -1 ent)))))))
                   p2 (cdr (assoc 10 (entget (entnext (cdar head)))))
              );setq
       );if
       (setq langle (ang p1 p2))
      )
);cond
;;first check to see if there is a current selection set
(if (setq ss1 (cadr(ssgetfirst)))
;;process the selection set
    (progn
      (rottxt-to-ang ss1 langle)
;;and cancel the grips
      (sssetfirst nil)
    );progn
;;otherwise prompt the user to select entities
  (progn
    (princ "\nSelect Text/Mtext Entities to Align:")
    (while (null ss1)
      (setq ss1 (ssget  '((-4 . "<OR")
                          (0 . "TEXT") (0 . "MTEXT")
                         (-4 . "OR>"))
               )
      )
    );while
;;and process the result
   (rottxt-to-ang ss1 langle) 
  );progn
);if
;;prompt the user to accept or rotate by 180
(initget "Accept Rotate")
(if (= (getkword "\nAccept or Rotate 180 <Accept>") "Rotate")
  (rottxt-by-ang ss1 PI)
)
;;unhighlight the entity used for alignment
  (redraw (car alist) 4)
  (vla-endundomark thisdwg)
  (princ)
);defun
(princ "\nAlignTxt V1.2 © 2004 Herman Mayfarth ...loaded.")
(princ "\nCommands: RotTxt, Rot180, AlignTxt")
(princ)