rotate text to align line

Hello to all

I want to rotate single text to take the angle of existing line in the drawing

thanks

Something like this?

 
(defun c:textalign()
 (setq line (car (entsel "Pick a line"))
         text (car (entsel "...and a text"))
         ang (angle (cdr (assoc 10 (entget line)))
                        (cdr (assoc 11 (entget line)))
                 )
         tl (entget text)
         tl (subst (cons 50 ang) (assoc 50 tl) tl)
         tl (entmod tl)
  )
  (progn)
 )

It is a very simple routine -just for demo- and it will crash if the user doesn't select what the routine expects

Get it. I today was ill, have not gone for work and have decided to write.

(defun c:talong(/ actDoc actSp cText curAng curDer curPar
	curStr curTxt lChr oldMode oldOff oldSize
	oldSnap pt1 pt2 rLst selObj selPt stFlag
	tmpLn tStr txTpt unStart whatDo)
 (vl-load-com)
 (defun asmi_EntselWithOptions(Message / grLst filPt selSet)
 (if Message
   (princ Message)
   (princ "\nSelect object: ")
   ); end if
    (setq lChr ""
	  grLst(list 2 678)
	  tStr ""
	  ); end setq
    (while
      (and
          (not
	    (member lChr '(" " "\r")))
	  (/= 3(car grLst))
	); end or
  (if
    (setq grLst(grread nil 4 2))
    (progn
      (cond
	  ((= 3(car grLst))
	   (setq filPt(cadr grLst)
	         selSet(ssget filPt)
	         ); end setq
	   (if selSet
	       (setq outVal
	        (list(ssname selSet 0)filPt))
	     ); end if
	   ); end cond #1
	  ((= 2(car grLst))
	   (setq lChr(chr(cadr grLst)))
	   (if
	     (not
	       (member lChr '(" " "\r")))
		     (progn
		     (setq tStr(strcat tStr lChr)
			   outVal tStr); end setq
		     (princ lChr)
	       ); end progn
	     ); end if
	   ); end cond #2
        ); end cond
       ); end progn
      ); end if
     ); end while
    outVal
   ); end of asmi_EntselWithOptions

 (defun asmi_LayersUnlock(/ restLst)
 (setq restLst '())
 (vlax-for lay
   (vla-get-Layers
            (vla-get-ActiveDocument
              (vlax-get-acad-object)))
   (setq restLst
    (append restLst
      (list
        (list
         lay
          (vla-get-Lock lay)
  (vla-get-Freeze lay)
         ); end list
        ); end list
      ); end append
   ); end setq
   (vla-put-Lock lay :vlax-false)
   (if
     (vl-catch-all-error-p
(vl-catch-all-apply
 'vla-put-Freeze(list lay :vlax-false)))
     t)
   ); end vlax-for
 restLst
 ); end of asmi_LayersUnlock

 (defun asmi_LayersStateRestore(StateList)
 (foreach lay StateList
   (vla-put-Lock(car lay)(cadr lay))
    (if
     (vl-catch-all-error-p
(vl-catch-all-apply
  'vla-put-Freeze(list(car lay)(nth 2 lay))))
      t)
   ); end foreach
 (princ)
    ); end of asmi_LayersStateRestore

 
;;===========================================================
;; UNFORMAT.LSP (c)2003, John F. Uhden, Cadlantic/CADvantage
;; v1.0 (04-01-03)
;; Removes MTEXT formatting with option to retain the "\\P" LineFeeds
;;
;; Arguments:
;; Mtext - either an Ename or VLA-Object
;; KeepLF - nil (discard LineFeeds) non-nil (retain LineFeeds)
;;
;; NOTES:
;; Only R15 or higher.
;; v1.0 is only the first attempt.
;; We can always embellish the code with additional options.
;; Yes, it can probably be sped up using integers, but this is legible.
;;
(defun UnFormat (Mtext KeepLF / Text Str)
(vl-load-com)
 (cond
    ((= (type Mtext) 'VLA-Object)); end condition #1
    ((= (type Mtext) 'ENAME)
     (setq Mtext (vlax-ename->vla-object Mtext))
     ); end condition #2
   (1 (setq Mtext nil)) ; end condition #3
 ); end cond
    (and
  Mtext
  (= (vlax-get Mtext 'ObjectName) "AcDbMText")
  (setq Mtext (vlax-get Mtext 'TextString))
  (setq Text "")
(while (/= Mtext "")
 (cond
   ((wcmatch (strcase
	(setq Str
	   (substr Mtext 1 2))) "\\[\\{}`~]")
    (setq Mtext (substr Mtext 3)
          Text (strcat Text Str)
          ); end setq
      ); ed condition #1
   ((wcmatch (substr Mtext 1 1) "[{}]")
     (setq Mtext (substr Mtext 2))
     ); end condition #2
   ((and KeepLF (wcmatch (strcase (substr Mtext 1 2)) "\\P"))
     (setq Mtext (substr Mtext 3)
           Text (strcat Text "\\P")
           ); end setq
     ); end condition #3
   ((wcmatch (strcase (substr Mtext 1 2)) "\\[LOP]")
     (setq Mtext (substr Mtext 3))
     ); end condition #4
    ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
       (setq Mtext
      (substr Mtext (+ 2 (vl-string-search ";" Mtext))))
     ); end condition #5
    ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
       (setq Str
       (substr Mtext 3
	       (- (vl-string-search ";" Mtext) 2))
             Text (strcat Text
		   (vl-string-translate "#^\\" " " Str))
             Mtext (substr Mtext (+ 4 (strlen Str)))
             ); end setq
        (print Str)
      ); end condition #6
    (1
      (setq Text (strcat Text (substr Mtext 1 1))
            Mtext (substr Mtext 2)
           ); end setq
      ); end condition #7
    ); end cond
 ); end while
); end and
 Text
); end of UnFormat

 (defun asmi_GetActiveSpace(/ actDoc spFlag)
     (setq actDoc(vla-get-ActiveDocument
                    (vlax-get-acad-object))
           spFlag(vla-get-ActiveSpace actDoc)
          ); end setq
      (if(= 0 spFlag)
         (setq actSp(vla-get-PaperSpace actDoc))
         (setq actSp(vla-get-ModelSpace actDoc))
       ); end if
   ); end of asmi_GetActiveSpace
 (asmi_GetActiveSpace)

 (defun EnvironmentRestore()
   (if oldSnap
     (setvar "OSMODE" oldSnap)
     ); end if
   (if unStart
     (vla-EndUndoMark actDoc)
     ); end if
   (if tmpLn
     (vla-Delete tmpLn)
     ); end if
   (if rLst
     (asmi_LayersStateRestore rLst)
     ); end if
   (if selObj
     (vla-Highlight selObj :vlax-false)
     ); end if
   (princ)
   ); end of EnvironmentRestore

 (defun *error*(msg)
   (EnvironmentRestore)
   (princ "\n<<< Console break. Quit. >>> ")
   (princ)
   ); end of *error*
 
 (if(not tal:mode)(setq tal:mode "Type"))
 (if(not tal:off)(setq tal:off 1.5))
 (if(not tal:size)(setq tal:size(getvar "TEXTSIZE")))
 (setq oldSnap(getvar "OSMODE"))
 (while
     (and
(/= 'LIST(type whatDo))
(not stFlag)
     ); end or
     (princ
       (strcat
     "\n<<< Mode = " tal:Mode ", Text size = " (rtos tal:size)
     ", Offset = " (rtos tal:off) " >>> ") ; end strcat
      ); end princ
 (setq whatDo
 (asmi_EntselWithOptions
   "\nSelect curve or [settings/Quit] > ")
); end setq
   (cond
     ((= 'LIST(type whatDo))
      (setq selObj
      (vlax-ename->vla-object
	(car whatDo))
     selPt T
     txtPt T
     ); end setq
      (if
 (member
   (vla-get-ObjectName selObj)
   '("AcDbLine" "AcDbPolyline" "AcDb3dPolyline"
     "AcDbSpline" "AcDbCircle" "AcDbEllipse"
     "AcDbArc" "AcDbRay" "AcDbXline")
   ); end menber
 (progn
   (vla-Highlight selObj :vlax-true)
   (setq rLst(asmi_LayersUnlock))
   (while
     (and selPt txtPt)
     (vla-StartUndoMark
       (setq actDoc
	  (vla-get-ActiveDocument
	    (vlax-get-acad-object))))
     (setq unStart T)
     (setvar "OSMODE" 3071)
     (if
       (setq selPt
	    (getpoint
	      "\nPick point on curve or Right Click to Quit > "); end getpoint
	   ); end setq
       (progn
     (if
       (setq curPar
	      (vlax-curve-GetParamAtPoint selObj
		(setq selPt(trans selPt 1 0))))
       (progn
	  (setq curDer
		 (vlax-curve-GetFirstDeriv selObj
                             curPar)
		); end setq
                (if(=(cadr curDer) 0.0)
                   (setq curAng (/ pi 2))
                     (setq curAng
			(- pi
			 (atan
			  (/(car curDer)
			    (cadr curDer)))))
                  ); end if
	 (setq pt1
		(polar selPt curAng (* tal:size tal:off))
	       pt2
		(polar selPt curAng (-(* tal:size tal:off)))
	       tmpLn(vla-AddLine actSp
		      (vlax-3D-point pt1)(vlax-3D-point pt2)
		      ); end vla-AddLine
	       ); end setq
	 (vla-put-Color tmpLn acRed)
	 (setvar "OSMODE" 1)
	 (if
	   (setq txtPt
		  (getpoint
		    "\nPick middle point of text or Right Click to Quit > ")
		 ); end setq
	   (progn
	     (setq txtPt
		    (vlax-3d-point
		      (trans txtPt 1 0))
		   curStr nil); end setq
	     (while(not curStr)
	     (if
	       (= tal:mode "Type")
	       (progn
	         (setq curStr
		      (getstring T
			"\nEnter text: "); end getstring
		     ); end setq
		 (if(= "" curStr)(setq curStr nil))
	       ); end progn
	       (progn
		 (if
		   (and
		     (setq cText
			  (nentsel
			    "\nCopy text > "))
		     (setq cText
			    (vlax-ename->vla-object(car cText)))
		     (member
		       (vla-get-ObjectName cText)
		       '("AcDbText" "AcDbMText" "AcDbAttribute")
		       ); end member
		   ); end and
		   (if
		     (= "AcDbMText"
			(vla-get-ObjectName cText))
		       (setq curStr
			    (UnFormat cText nil)); end setq
		       (setq curStr
			      (vla-get-TextString cText)); end setq
		     ); end if
	           ); end if
		 ); end progn
	       ); end if
	       (if(not curStr)
		 (princ "\n>>> Empty input! <<< ")
		 (progn
		 (setq curTxt
			(vla-addText actSp curStr
			  txtPt tal:size)); end setq
		 (if
		   (and(< curAng(* 2 pi))(> curAng pi))
			 (vla-put-Rotation curTxt (+ curAng(/ pi 2)))
			 (vla-put-Rotation curTxt (- curAng(/ pi 2)))
		   ); end if
			 (vla-put-Alignment curTxt acAlignmentMiddleCenter)
			 (vla-Move curTxt
				   (vla-get-TextAlignmentPoint curTxt)
				   txtPt); end move
		   ); end progn
		 ); end if
	      ); end while
	     ); end progn
	   (princ "\n<<< Quit >>> ")
	   ); end if

Continue in next post...

		 (vla-Delete tmpLn)
	 (setq tmpLn nil)
	 ); end progn
        (progn
         (princ "\n>>> Point isn't at curve! Quit. <<< ")
	 (setq selPt nil)
        ); end progn
       ); end if
     ); end progn
       (princ "\n<<< Quit >>> ")
       ); end if
     (vla-EndUndoMark actDoc)
     (setq unStart nil)
     ); end while
   (vla-Highlight selObj :vlax-false)
   (asmi_LayersStateRestore rLst)
   ); end progn
 (princ "\n>>> This isn't curve! Quit. <<< ")
 ); end if
      ); end condition #1
     ((= "S" (strcase whatDo))
      (initget "Type Copy")
       (setq oldMode tal:mode
      oldOff tal:off
      oldSize tal:size
      tal:mode
       (getkword
	 (strcat
	   "\nSpecify text creation mode [Type/Copy] <"
	   tal:mode ">: "); end strcat
	 ); end getkword
      tal:size
       (getreal
	 (strcat
	   "\nSpecify text size <"
	   (rtos tal:size) ">: "); end strcat
	 ); end getreal
      tal:off
       (getreal
	 (strcat
	   "\nSpecify text offset from line. TEXT SIZE * <"
	   (rtos tal:off) ">: "); end strcat
	 ); end getreal
      ); end setq
      (if(null tal:mode)(setq tal:mode oldMode))
      (if(null tal:size)(setq tal:size oldSize))
      (if(null tal:off)(setq tal:off oldOff))
      ); end condition #2
     ((= "Q" (strcase whatDo))
      (princ "\n<<< Quit >>> ")
      (setq stFlag T)
      ); end condition #3
     (T
       (princ "\nInvalid option keyword. ")
      ); end condition #4
     ); end cond
   ); end while
 (EnvironmentRestore)
 (princ)
 ); end of c:talong

The End...

Nice one, ASMI, hope you feel better soon.

Here is one to play with.

;;  TextAlignWithObject.lsp
;;  CAB   02/19/2007
;;
;;  Add text to DWG at angle of selected object

(defun c:tao() (c:TextAlignWithObject)) ; shortcut

(defun c:TextAlignWithObject (/ tmp ang p@pt parA parB pt start txtht 
              FixTextAngle addtext)
 (vl-load-com)
 ;;  Returns a text angle in radians, flops text at >90 and <270 
 (defun FixTextAngle (ang)
   (if (and (> ang (* 0.5 pi)) (< ang (* 1.5 pi)))
     (+ ang pi)
     ang
   )
 )


 ;;  Create a text object
 (defun addtext (ipt hgt text ang lay / txtObj)
   (setq txtObj
          (vla-addtext
            (if (= (getvar 'cvport) 1)
              (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
              (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
            )
            text
            (vlax-3d-point ipt)
            hgt
          )
   )
   (vla-put-layer txtObj lay)
   (vla-put-rotation txtObj ang)
   (vla-put-alignment txtObj acalignmentbottomcenter)
   (vla-put-textalignmentpoint txtobj (vlax-3d-point ipt))

 )

 ;;  -=< START HERE  >=-
 
 ;;  Get text string to insert
 (or txtstr (setq txtstr "Default Text"))
 (if (/= (setq tmp (getstring t (strcat "\nEnter text string: < " txtstr " > "))) "")
   (setq txtstr tmp)
 )

 ;;  Get object to align text & insert point
 ;;  Object must have curve data
 (if (and (setq ent (entsel "\nSelect point on object to label."))
          (not (vl-catch-all-error-p
                 (setq pt (vl-catch-all-apply
                               'vlax-curve-getClosestPointTo
                               (list (car ent) (cadr ent))
                             )
                 )
               )
          )
     )
   (progn
     (setq ent  (car ent)
           p@pt (vlax-curve-getParamAtPoint ent pt)
           parA (max 0.0 (- p@pt 0.05))
           parB (min (+ p@pt 0.05) (vlax-curve-getEndParam ent))
           ang  (angle (vlax-curve-getPointAtParam ent parA)
                       (vlax-curve-getPointAtParam ent ParB)
                )  ; aprox angle of curve at pick point
           ang  (FixTextAngle ang)
     )
     ;;  Text height by style or current Text Size
     (if (zerop (setq txtht (getvar 'textsize)))
       (setq txtht (getvar "TextSize"))
     )
     (addtext pt txtht txtstr ang (getvar "clayer")) ; ins hgt text ang 
   )
   (prompt "\n**  Missed or no curve data for object.")
 )
 (princ)
)
(prompt "\nTextAlignWithObject.lsp loaded enter TAO to run.")
(princ)

thank you friends for your replies

one thing more mr CaB can you modify the routin that enable me to pick existing text in the drawing in addition to enter new one(optional)

thank you very much

>CAB

Hi. Fine lisp. I like idea with a selection of a point and a curve simultaneously by means of 'entsel' and prcise coordinates with 'vlax-curve-getClosestPointTo'. However I think that it is possible to make absolutely well. Look my function 'asmi_EntselWithOptions' on the basis of 'grread'. It is possible to make inquiry of type ' Select point on curve or [Mirror(last)/mOve(last)/(change)siDe/Settings]: '. It will make possible to change the side for last text, to move it, to change side for all next texts and change settings (text size, distance from curve and also select of modes the [Type/Copy]) as required without interruption of the command and superfluous inquiries. Those to whom to an options are not necessary, can not use it as though it are not present.

You like such idea?

Unfortunately now absolutely there is no time. I have passed two days on work and I have some more important issues.

Asmi,

Yes I like the idea and I do like your lisp.

Mine is but a simple lisp for a spacific pourpose.

thank you friends for your replies

one thing more mr CaB can you modify the routin that enable me to pick existing text in the drawing in addition to enter new one(optional)

thank you very much

It's very simple, why don't you give it a try.

Post your code and someone will help you complete it.

OK, try this one.

;;  Text Rotated to the selected object angle
(defun c:TRA() (c:TextRotate2Angle))

(defun c:TextRotate2Angle (/ ss lst pt ang obj
                 get_pt_and_angle )
 (vl-load-com)


 ;;  User selection of curve object
 ;;  return pick point & average angle of curve at pick point
 (defun get_pt_and_angle (prmpt / ent p@pt parA parB pt ang)
   (if (and (setq ent (entsel prmpt))
            (not (vl-catch-all-error-p
                   (setq pt (vl-catch-all-apply
                              'vlax-curve-getClosestPointTo
                              (list (car ent) (cadr ent))
                            )
                   )
                 )
            )
       )
     (progn
       (setq ent  (car ent)
             p@pt (vlax-curve-getParamAtPoint ent pt)
             parA (max 0.0 (- p@pt 0.05))
             parB (min (+ p@pt 0.05) (vlax-curve-getEndParam ent))
             ang (angle (vlax-curve-getPointAtParam ent parA)
                        (vlax-curve-getPointAtParam ent ParB)
                 )
       )
       (list pt ang)
     )
   )
 )

 
 ;;  Get Text to align & object to alignment angle
 ;;  Text is not moved, just rotated to the alignment angle
 ;;  Object must have curve data
 (prompt "\nSelect text object to align.")
 (if (and (or (setq ss  (ssget "_+.:E:S" '((0 . "Text,Mtext"))))
              (prompt "\n**  No Text object selected.  **"))
          (or (setq lst (get_pt_and_angle "\nSelect point on object to label."))
              (prompt "\n**  Missed or no curve data for object."))
      )
   (progn
     (setq pt  (car lst)
           ;; ang (FixTextAngle (cadr lst))
           ang (cadr lst)
           obj (vlax-ename->vla-object (ssname ss 0))
     )
     (vla-put-rotation Obj ang)
   )
   
 )
 (princ)
)

I try to move the text which selected in the drwaing to the point on line

(command "_move" ss ? lst )

here i don,t know the base point of the text then is the other correct

thanks CAB

;;  Text Rotated to the selected object angle
(defun c:TRA() (c:TextRotate2Angle))

(defun c:TextRotate2Angle (/ ss lst pt ang obj
                 get_pt_and_angle )
 (vl-load-com)


 ;;  User selection of curve object
 ;;  return pick point & average angle of curve at pick point
 (defun get_pt_and_angle (prmpt / ent p@pt parA parB pt ang)
   (if (and (setq ent (entsel prmpt))
            (not (vl-catch-all-error-p
                   (setq pt (vl-catch-all-apply
                              'vlax-curve-getClosestPointTo
                              (list (car ent) (cadr ent))
                            )
                   )
                 )
            )
       )
     (progn
       (setq ent  (car ent)
             p@pt (vlax-curve-getParamAtPoint ent pt)
             parA (max 0.0 (- p@pt 0.05))
             parB (min (+ p@pt 0.05) (vlax-curve-getEndParam ent))
             ang (angle (vlax-curve-getPointAtParam ent parA)
                        (vlax-curve-getPointAtParam ent ParB)
                 )
       )
       (list pt ang)
     )
   )
 )

 
 ;;  Get Text to align & object to alignment angle
 ;;  Text is not moved, just rotated to the alignment angle
 ;;  Object must have curve data
 (prompt "\nSelect text object to align.")
 (if (and (or (setq ss  (ssget "_+.:E:S" '((0 . "Text,Mtext"))))
              (prompt "\n**  No Text object selected.  **"))
          (or (setq lst (get_pt_and_angle "\nSelect point on object to label."))
              (prompt "\n**  Missed or no curve data for object."))
      )
   (progn
     (setq pt  (car lst)
           ;; ang (FixTextAngle (cadr lst))
           ang (cadr lst)
           obj (vlax-ename->vla-object (ssname ss 0))
     )
     (vla-put-rotation Obj ang)
     (if (zerop (vla-get-Alignment obj))
       (vla-put-InsertionPoint obj (vlax-3d-point pt))
       (vla-put-textalignmentpoint obj (vlax-3d-point pt))
     )
   )
   
 )
 (princ)
)

thank you CAB

CAB

thanx for great lisp

there is one comment

try to align text to 2 lines one drawn from right to left and 2nd line drawn from left to right

what about adding that options to the lisp

1- Angle from object ( to use in case of needed the text in the other direction i'll use angle = 180).

2- Gab between text and objects.

See attached

Thanx

The problem you experienced is with a line that appears to be 270 or 90 degrees but is off by very small amount.

This version has a tolerance for those angles. Does it now work for you?

;;;     TextAlignWithObject.lsp
;;;      by Charles Alan Butler
;;;         Copyright 2007
;;;  by Precision Drafting & Design All Rights Reserved.
;;;  Contact at ab2draft @ TampaBay.rr.com
;;;
;;;   Version 1.0 Beta  Feb 19, 2007
;;;   Version 1.1 Beta  Aug 20, 2008, added fuzz to angle detection
;;;
;;; DESCRIPTION 
;;; Add text to DWG at angle of selected object
;;;
;;;
;;;  Limitations
;;;  No error checking
;;;
;;;
;;; Command Line Usage 
;;; Command: TAO
;;;
;;;
;;;  This software is provided "as is" without express or implied      ;
;;;  warranty.  All implied warranties of fitness for any particular   ;
;;;  purpose and of merchantability are hereby disclaimed.             ;
;;;  You are hereby granted permission to use, copy and modify this    ;
;;;  software without charge, provided you do so exclusively for       ;
;;;  your own use or for use by others in your organization in the     ;
;;;  performance of their normal duties, and provided further that     ;
;;;  the above copyright notice appears in all copies and both that    ;
;;;  copyright notice and the limited warranty and restricted rights   ;
;;;  notice appear in all supporting documentation.                    ;


(defun c:tao() (c:TextAlignWithObject)) ; shortcut

(defun c:TextAlignWithObject (/ tmp ang pt txtht FixTextAngle addtext)
 (vl-load-com)

 ;;  ------------------< sub functions >----------------------
 ;;  Returns a text angle in radians, flops text at >90 and <270 
 (defun FixTextAngle (ang)
   (if (and (> ang (+ (* 0.5 pi) 0.0001)) (< ang (+ (* 1.5 pi) 0.0001)))
     (+ ang pi)
     ang
   )
 )


 ;;  Create a text object 
 (defun addtext (ipt   ; insert point
                 hgt   ; text height
                 text  ; text string
                 ang   ; test angle
                 aln   ; text alignment
                 lay   ; text layer
                 / txtObj)
   (setq txtObj
          (vla-addtext
            (if (= (getvar "cvport") 1)
              (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
              (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
            )
            text
            (vlax-3d-point ipt)
            hgt
          )
   )
   (vla-put-layer txtObj lay)
   (vla-put-rotation txtObj ang)
   (vla-put-alignment txtObj aln)
   (vla-put-textalignmentpoint txtobj (vlax-3d-point ipt))

 )

 ;;  User selection of curve object
 ;;  return pick point & average angle of curve at pick point
 (defun get_pt_and_angle (prmpt / ent p@pt parA parB pt ang)
   (if (and (setq ent (entsel prmpt))
            (not (vl-catch-all-error-p
                   (setq pt (vl-catch-all-apply
                              'vlax-curve-getClosestPointTo
                              (list (car ent) (cadr ent))
                            )
                   )
                 )
            )
       )
     (progn
       (setq ent  (car ent)
             p@pt (vlax-curve-getParamAtPoint ent pt)
             parA (max 0.0 (- p@pt 0.05))
             parB (min (+ p@pt 0.05) (vlax-curve-getEndParam ent))
             ang (angle (vlax-curve-getPointAtParam ent parA)
                        (vlax-curve-getPointAtParam ent ParB)
                 )
       )
       (list pt ang)
     )
   )
 )



 
 ;;  ------------------< START HERE >----------------------
 
 ;;  Get text string to insert
 (or txtstr (setq txtstr "Default Text"))
 (if (/= (setq tmp (getstring t (strcat "\nEnter text string: < " txtstr " > "))) "")
   (setq txtstr tmp)
 )

 ;;  Get object to align text & insert point
 ;;  Object must have curve data
 (if (setq lst (get_pt_and_angle "\nSelect point on object to label."))
   (progn
     (setq pt  (car lst)
           ang (FixTextAngle (cadr lst))
     )
     ;;  Text height by style or current Text Size
     (if (zerop (setq txtht (getvar 'textsize)))
       (setq txtht (getvar "TextSize"))
     )
     (addtext pt txtht txtstr ang acalignmentbottomcenter (getvar "clayer")) 
   )
   (prompt "\n**  Missed or no curve data for object.")
 )
 (princ)
)
(prompt "\nTextAlignWithObject.lsp loaded enter TAO to run.")
(princ)



;;========================================
;;  Text Rotated to the selected object angle
;;   Version 1.1 Beta  Feb 23,2007
;;========================================

(defun c:TRA() (c:TextRotate2Angle))

(defun c:TextRotate2Angle (/ ss lst pt ang obj
                 get_pt_and_angle )
 (vl-load-com)


 ;;  ------------------< sub functions >----------------------
 ;;  Returns a text angle in radians, flops text at >90 and <270 
 (defun FixTextAngle (ang)
   (if (and (> ang (* 0.5 pi)) (< ang (* 1.5 pi)))
     (+ ang pi)
     ang
   )
 )
 
 ;;  User selection of curve object
 ;;  return pick point & average angle of curve at pick point
 (defun get_pt_and_angle (prmpt / ent p@pt parA parB pt ang)
   (if (and (setq ent (entsel prmpt))
            (not (vl-catch-all-error-p
                   (setq pt (vl-catch-all-apply
                              'vlax-curve-getClosestPointTo
                              (list (car ent) (cadr ent))
                            )
                   )
                 )
            )
       )
     (progn
       (setq ent  (car ent)
             p@pt (vlax-curve-getParamAtPoint ent pt)
             parA (max 0.0 (- p@pt 0.05))
             parB (min (+ p@pt 0.05) (vlax-curve-getEndParam ent))
             ang (angle (vlax-curve-getPointAtParam ent parA)
                        (vlax-curve-getPointAtParam ent ParB)
                 )
       )
       (list pt ang)
     )
   )
 )

 
 ;;  Get Text to align & object to alignment angle
 ;;  Text is not moved, just rotated to the alignment angle
 ;;  Object must have curve data
 (prompt "\nSelect text object to align.")
 (if (and (or (setq ss  (ssget "_+.:E:S" '((0 . "Text,Mtext"))))
              (prompt "\n**  No Text object selected.  **"))
          (or (setq lst (get_pt_and_angle "\nSelect point on object to label."))
              (prompt "\n**  Missed or no curve data for object."))
      )
   (progn
     (setq pt  (car lst)
           ang (FixTextAngle (cadr lst))
           ;;ang (cadr lst)
           obj (vlax-ename->vla-object (ssname ss 0))
     )
     (vla-put-rotation Obj ang)
     (if (zerop (vla-get-Alignment obj))
       (vla-put-InsertionPoint obj (vlax-3d-point pt))
       (vla-put-textalignmentpoint obj (vlax-3d-point pt))
     )
   )
   
 )
 (princ)
)

As for your Options request, would the GAP be applied when an offset angle option is chosen?

What would you do with the case of a negative offset angle?

I cant select the text

Command: TAO

 

Enter text string:

 

Select point on object to label.

This version only allows user entry of text string.

I assume you want that option too.

i think that no need for gap but its better to be applied (in case some one need)

I when add text to a plan the text should be in one direction to read together so some times i want to make the negative direction

i saw in a thread but don't remember i'll search for.

Thanx

I think that it is pleasant to much

(defun c:talon(/ cWid cHei cStr tVrx cCur grDat stFlg
         cAng sPt cPt aPt bPt pt1 pt2 pt3 pt4
         nTxt mPt xPt oldStr)

(vl-load-com)
 

(if(not(getenv "talon:tsize"))
 (setenv "talon:tsize"(rtos(getvar "TEXTSIZE")))
 ); end if
(if(not(getenv "talon:offset"))
 (setenv "talon:offset"(rtos(/(getvar "TEXTSIZE")2)))
 ); end if
(if(not talon:str)(setq talon:str ""))
(setq oldStr talon:str)
(princ
 (strcat "\nSize = " (getenv "talon:tsize")
  ", Offset = " (getenv "talon:offset")
  ", TALONSET to settings. "); end strcat
 ); end princ
(setq talon:str(getstring T
	   (strcat "\nSpecify text <"
		    talon:str ">: ")))
(if(= "" talon:str)(setq talon:str oldStr))
(if(/= talon:str "")
 (progn
  (setq tVrx(textbox(list(cons 1 talon:str)
	(cons 40(atof(getenv "talon:tsize")))))
 actDoc(vla-get-ActiveDocument
	 (vlax-get-acad-object))
 ); end setq
  (if(= 1(getvar "TILEMODE"))
    (setq actSp(vla-get-ModelSpace actDoc))
    (setq actSp(vla-get-PaperSpace actDoc))
    ); end if
  (setq cWid(caadr tVrx)
 cHei(cadadr tVrx)
 ); end setq
  (if(setq cCur(entsel "\nSelect curve > "))
    (if(member(cdr(assoc 0(entget(car cCur))))
      '("LINE" "LWPOLYLINE" "POLYLINE"
	"CIRCLE" "ELLIPSE" "ARC" "SPLINE"))
     (progn
(setq cCur(vlax-ename->vla-object(car cCur)))
 (while
   (and
    (= 5(car(setq grDat(grread T 1))))
    (not stFlg)
   ); end and
    (redraw)
   (if(= 'LIST(type(setq sPt(cadr grDat))))
     (progn
      (setq cPt(vlax-curve-GetClosestPointTo cCur sPt)
	    cAng(angle cPt sPt)
	    aPt(polar cPt cAng(atof(getenv "talon:offset")))
	    bPt(polar cPt cAng(+(atof(getenv "talon:offset"))
				(atof(getenv "talon:tsize"))))
	    pt1(polar aPt(+ cAng(/ pi 2))(/ cWid 2))
	    pt2(polar aPt(- cAng(/ pi 2))(/ cWid 2))
	    pt3(polar bPt(- cAng(/ pi 2))(/ cWid 2))
	    pt4(polar bPt(+ cAng(/ pi 2))(/ cWid 2))
	    ); end setq
           (grvecs(list 3 pt1 pt2 3 pt2 pt3
			3 pt3 pt4 3 pt4 pt1))
        ); end progn
      ); end if
    ); end while
     (if(= 3(car grDat))
       (progn
               (setq stFlg T
	      nTxt(vla-AddText actSp talon:str
		   (vlax-3D-point '(0.0 0.0 0.0))
		    (atof(getenv "talon:tsize")))
	      tVrx(textbox(entget(entlast)))
	      mPt(vlax-3d-Point
		   (mapcar '/
		    (mapcar '+
		      (car tVrx)(cadr tVrx))
			  '(2.0 2.0 1.0)))
	      xPt(vlax-3d-Point
		   (mapcar '/
		    (mapcar '+
		      aPt bPt)
			  '(2.0 2.0 1.0)))
	      ); end setq
	  (vla-Move nTxt mPt xPt)
	  (if(and(> cAng 0)(<= cAng pi))
	    (vla-Rotate nTxt xPt(- cAng(/ pi 2)))
	    (vla-Rotate nTxt xPt(+ cAng(/ pi 2)))
	   ); end if
       (redraw)
      ); end progn
    ); end if
  ); end progn
       (princ "\n<!> Invalid object <!> ")
       ); end if
     ); end if
   ); end progn
  (princ "\n<!> Empty string <!> ")
 ); end if
 (princ)
 ); end of c:talon




(defun c:talonset(/ tSize tOff)
  (if(not(getenv "talon:tsize"))
     (setenv "talon:tsize"(rtos(getvar "TEXTSIZE")))
    ); end if
  (if(not(getenv "talon:offset"))
    (setenv "talon:offset"(rtos(/(getvar "TEXTSIZE")2)))
   ); end if
 (if(setq tSize(getreal
	  (strcat "\nSpecify text size <"
		  (getenv "talon:tsize") ">: ")))
   (setenv "talon:tsize"(rtos tSize))
   ); end if
 (if(setq tOff(getreal
	  (strcat "\nSpecify offset from curve <"
		  (getenv "talon:offset") ">: ")))
   (setenv "talon:offset"(rtos tOff))
   ); end if
 (princ)
 ); end of c:talonset