Topic: Text align routine

[bman]

I've searched high & low & can't find this routine but i know it's here because i've seen it in the past....I'm looking for a routine that rotates Text/Mtext to the same angle as a selected pline, line or text entity. Any ideas?

[Ron Heigh]

Code: [Select]

;;;    TA.LSP   Version 3.0  - 01 MAR 1998
;;;
;;;    Copyright 1998 by R.K. McSwain
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    R.K. McSwain provides this program "AS IS" and with all faults.
;;;    R.K. McSwain specifically disclaims any implied warranty of
;;;    merchantability or fitness for a particular use.  autodesk, inc.
;;;    does not warrant that the operation of the program will be
;;;    uninterrupted or error free.

;;;    This program will match text angle to a line angle selected
;;;--------------------------------------------------------------------
(defun c:textalign ( / ang1 ang2 bob enttyp enttyp2 getit l1 nang oang oangprt p1 p2 sl st time time2 tx1 wait wait2 why x1 x2 )

(setvar "cmdecho" 1)

;finds the angle of the line
  (setq wait "T")
  (while wait
   (setq time "T")
   (while time
    (setq sl (entsel "\n Pick Angle To Match:"))
    (if (/= sl nil)(setq time nil))
   )
   (setq l1 (entget (car sl)))
   (setq enttyp (cdr (assoc 0 l1)))
   (if (= enttyp "LINE")(setq wait nil))
  )
  (setq p1 (cdr (assoc 10 l1)))
  (setq x1 (car p1))
  (setq p2 (cdr (assoc 11 l1)))
  (setq x2 (car p2))

(setq why (angle p1 p2))
        (if (>= why 0)
          (setq ang1 why)
        )
        (if (> why 1.5708);same as 90°
          (setq ang1 (+ 3.14159 why));add 180°
        )
        (if (>= why 4.71413);same as 270.1°
          (setq ang1 why)
        )

;finds angle of txt
  (setq wait2 "T")
  (while wait2
   (setq time2 "T")
   (while time2
    (setq st (entsel "\n Pick Text To Change:"))
    (if (/= st nil)(setq time2 nil))
   )
   (setq tx1 (entget (car st)))
   (setq enttyp2 (cdr (assoc 0 tx1)))
   (if (= enttyp2 "TEXT")(setq wait2 nil))
  )
  (setq ang2 (cdr (assoc 50 tx1)))
  (setq oang (cons 50 ang2))
  (setq nang (cons 50 ang1))
  (setq tx1 (subst nang oang tx1))
  (entmod tx1)
  (terpri)
  (setq bob "T")
  (while bob
   (initget 6 "M m")
   (setq getit (getkword "\n Press M to rotate 180° or <ENTER> to quit "))
   (if (or (= getit "m") (= getit "M"))
       (progn
        (setq oang (assoc 50 tx1))
        (setq oangprt (cdr oang))
        (setq nang (cons 50 (+ 3.14159 oangprt)))
        (setq tx1 (subst nang oang tx1))
        (entmod tx1)
       )
       (setq bob nil)
   )
  )

  (setvar "cmdecho" 0)
  (princ)
)

[rktect3j]

Code: [Select]

;;;    TA.LSP   Version 3.0  - 01 MAR 1998
;;;
;;;    Copyright 1998 by R.K. McSwain
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    R.K. McSwain provides this program "AS IS" and with all faults.
;;;    R.K. McSwain specifically disclaims any implied warranty of
;;;    merchantability or fitness for a particular use.  autodesk, inc.
;;;    does not warrant that the operation of the program will be
;;;    uninterrupted or error free.

;;;    This program will match text angle to a line angle selected
;;;--------------------------------------------------------------------
(defun c:textalign ( / ang1 ang2 bob enttyp enttyp2 getit l1 nang oang oangprt p1 p2 sl st time time2 tx1 wait wait2 why x1 x2 )

(setvar "cmdecho" 1)

;finds the angle of the line
  (setq wait "T")
  (while wait
   (setq time "T")
   (while time
    (setq sl (entsel "\n Pick Angle To Match:"))
    (if (/= sl nil)(setq time nil))
   )
   (setq l1 (entget (car sl)))
   (setq enttyp (cdr (assoc 0 l1)))
   (if (= enttyp "LINE")(setq wait nil))
  )
  (setq p1 (cdr (assoc 10 l1)))
  (setq x1 (car p1))
  (setq p2 (cdr (assoc 11 l1)))
  (setq x2 (car p2))

(setq why (angle p1 p2))
        (if (>= why 0)
          (setq ang1 why)
        )
        (if (> why 1.5708);same as 90°
          (setq ang1 (+ 3.14159 why));add 180°
        )
        (if (>= why 4.71413);same as 270.1°
          (setq ang1 why)
        )

;finds angle of txt
  (setq wait2 "T")
  (while wait2
   (setq time2 "T")
   (while time2
    (setq st (entsel "\n Pick Text To Change:"))
    (if (/= st nil)(setq time2 nil))
   )
   (setq tx1 (entget (car st)))
   (setq enttyp2 (cdr (assoc 0 tx1)))
   (if (= enttyp2 "TEXT")(setq wait2 nil))
  )
  (setq ang2 (cdr (assoc 50 tx1)))
  (setq oang (cons 50 ang2))
  (setq nang (cons 50 ang1))
  (setq tx1 (subst nang oang tx1))
  (entmod tx1)
  (terpri)
  (setq bob "T")
  (while bob
   (initget 6 "M m")
   (setq getit (getkword "\n Press M to rotate 180° or <ENTER> to quit "))
   (if (or (= getit "m") (= getit "M"))
       (progn
        (setq oang (assoc 50 tx1))
        (setq oangprt (cdr oang))
        (setq nang (cons 50 (+ 3.14159 oangprt)))
        (setq tx1 (subst nang oang tx1))
        (entmod tx1)
       )
       (setq bob nil)
   )
  )

  (setvar "cmdecho" 0)
  (princ)
)

That is a nice little routine but can we make it an Mtextalign routine?  Just a thought.

[bman]

Thanks Ron!

[hendie]

*cough* there's an mtext align routine on www.resourcecad.com in the free downloads, if you don't want to roll your own

[paulmcz]

For that I made this little tool but when it comes to copy rotation from another text, I use matchprop command

Code: [Select]

(defun c:rtt (/ ss oan nan p1 rot osn)
  (princ "\n Rotate, Select objects: ")
  (setq ss (ssget))
  (setq oan (getangle "\n Angle to be corrected: "))
  (setq nan (getangle "\n New absolute angle: "))
  (setq p1 (getpoint "\n Base point of rotation: "))
  (setq rot (/ (* (- nan oan) 180) pi))
  (setq osn (getvar "osmode"))
  (setvar "osmode" 0)
  (command "rotate" ss "" p1 rot)
  (setvar "osmode" osn)
  (princ)
  )

[Mark]

Here's my shot at it.

Code: [Select]


(defun c:rrt (/
               ; local functions
               getSegment get-opp-ang undobegin undoend
               ; local variables
               ent 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
  ;;;
  ;;; 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 ======================

  (cond ((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))
                )
               (T (alert "That's not an entity I deal with"))
               )
         )

        )

  (if ang
    (cond ((setq ent (car (entsel "\nSelect text to align")))
           (setq obj (vlax-ename->vla-object ent)
                 obj_typ (vlax-get-property obj 'ObjectName)
                 )
           (cond
             ((or (= obj_typ "AcDbMText") (= obj_typ "AcDbText"))
              (undobegin)
              (vlax-put-property obj 'Rotation ang)
              (setq ans (getstring "\nRotate 180 [Y/N]<N>: "))
              (if (= (strcase ans) "Y")
                (vlax-put-property obj 'Rotation (get-opp-ang ang))
                )
              (vlax-release-object obj)
              (undoend)
              )

             (T (alert "I only know how to align (M)TEXT, sorry! "))
             )
           )
          )
    )
  (princ)
  )


[dubb]

for this operation i use a routine to change my snap angle by selecting an entitiy and then rotate the entity i want to rotate. its not as good as a full-on routine but it works just as good. and it doesnt matter whether its text or mtext.