;;;Place text above or below a line or polyline segment. ("above" breaks @ 107^-287^)
;;;
;;;              
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 4-7-95
;;;>		   EDITED: 01-03-2007
;;;
(DEFUN C:LSTR (/	bkp1b	 bkp1m	  bkp1r	   bkp1l    bkp1a
	       bkp2b	bkp2m	 bkp2r	  bkp2l	   bkp2a    bkp3b
	       bkp3m	bkp3r	 bkp3l	  bkp3a	   selpt    tstpt
	       templ	oldcl	 clayr	  endp1	   endp2    lang
	       ldist	osang	 txtht	  ptabv	   ptblw    lstr_ent
	      )
  (SETQ oldlstr_osmode (GETVAR "OSMODE"))
  (SETVAR "OSMODE" 0)
  (IF c:mklayr
    nil
    (LOAD "mklayr" "\nFile MKLAYR.LSP not loaded! ")
  ) ;_ end of if
  (c:svlayr)
  (IF dimscl
    nil
    (LOAD "dimscl" "\nFile DIMSCL.LSP not loaded! ")
  ) ;_ end of if
  (dimscl)
  (IF getstyle
    nil
    (LOAD "getstyle" "\nFile GETSTYLE.LSP not loaded! ")
  ) ;_ end of if
  (getstyle "A")
  (IF ustr
    nil
    (LOAD "ustr" "\nFile USTR.LSP not loaded! ")
  ) ;_ end of if
  (IF ukword
    nil
    (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")
  ) ;_ end of if
  (IF txtsize
    nil
    (LOAD "txtsize" "\nFile TXTSIZE.LSP not loaded! ")
  ) ;_ end of if
  (txtsize NIL)
;;;  (SETQ	thts (ustr 1
;;;		   "\n\"Leroy Template Size\" or Standard(=110) "
;;;		   (IF thts
;;;		     thts
;;;		     "Standard"
;;;		   ) ;_ end of if
;;;		   nil
;;;	     ) ;_ end of ustr
;;;  ) ;_ end of setq
  (COND
    ((OR (EQ (SUBSTR thts 1 1) "S") (EQ (SUBSTR thts 1 1) "s"))
     (SETQ colr "6")
    )
    ((<= (ATOI thts) 80)
     (SETQ colr "1")
    )
    ((<= (ATOI thts) 125)
     (SETQ colr "6")
    )
    ((< (ATOI thts) 200)
     (SETQ colr "4")
    )
    ((>= (ATOI thts) 200)
     (SETQ colr "2")
    )
    (thts
     (SETQ colr	"6"
	   thts	"110"
     ) ;_ end of setq
    )
  )					;cond
  (IF (OR (EQ (SUBSTR thts 1 1) "S") (EQ (SUBSTR thts 1 1) "s"))
    (SETQ txtht (* 0.110 dimsc))
    (SETQ txtht (* (* (ATOI thts) 0.001) dimsc))
  )					;if
					;  (setvar "TEXTSIZE" txtht)
;;;  (PRINC "\nSelect Line: ")
;;;  (WHILE
;;;    (AND
;;;      (SETQ selpt (GRREAD))
;;;      (OR
;;;	(EQ (NTH 0 selpt) 3)
;;;	(EQ (NTH 0 selpt) 12)
;;;      )					;or
;;;    )					;and
;;;     (SETQ tstpt (NTH 1 selpt))
     (WHILE
       (AND
	 (SETQ sel1 (NENTSELP "Select Line: "))
	 (EQ (TYPE (SETQ tstpt (CADR sel1))) 'LIST)
	 (EQ (TYPE (CAR tstpt)) 'REAL)
	 (OR
	   (EQ "LINE" (CDR (ASSOC 0 (ENTGET (CAR sel1)))))
	   (EQ "VERTEX" (CDR (ASSOC 0 (ENTGET (CAR sel1)))))
	 )				;or
       )				;and
	(PROGN
	  (IF debug_lstr
	    (PROGN
	      (SETQ selent sel1)
	      (PRINC "\nFound it! selent=")
	      (PRINC selent)
	      (PRINC "\n(CDR (ASSOC 0 (ENTGET (CAR selent))))=")
	      (PRINC (CDR (ASSOC 0 (ENTGET (CAR selent)))))
	      (PRINC "\n(CDR (ASSOC 0 (ENTGET (CAR (LAST selent)))))=")
	      (PRINC (CDR (ASSOC 0 (ENTGET (CAR (LAST selent))))))
	      (PRINC)
	    )
	  )
	  (SETQ	oldcl clayr
		clayr (CDR (ASSOC 8 (ENTGET (CAR sel1))))
	  )				;setq
	  (IF (clnmstd)
	    (PROGN
	      (SETQ mjrg (SUBSTR clayr 1 1)
		    llt	 "-"
		    prod (SUBSTR clayr 3 4)
		    modf "NOTE"
	      )				;setq
	      (c:mklayr)
	    )				;progn
	    (PROGN
	      (SETQ clayr oldcl)
	      (c:slent)
	    )				;progn
	  )
	  (COND
	    ((AND(EQ "LINE" (CDR (ASSOC 0 (ENTGET (CAR sel1)))))(EQ "INSERT" (CDR (ASSOC 0 (ENTGET (CAR sel1))))))
	      (SETQ endp1
		   (POLAR
		     (POLAR (CDR(ASSOC 10(ENTGET(CAR sel1))))
				 (CDR(ASSOC 50(ENTGET(CAR sel1))))
				 (*(CDR(ASSOC 41(ENTGET(CAR sel1))))(CADR(ASSOC 10(ENTGET(CAR sel1)))))
		     )
		     (+(CDR(ASSOC 50(ENTGET(CAR sel1))))(/ PI 2.0))
		     (*(CDR(ASSOC 42(ENTGET(CAR sel1))))(CADDR(ASSOC 10(ENTGET(CAR sel1)))))
		   )
	      )
	     )
	    (T (SETQ endp1 (TRANS (CDR (ASSOC 10 (ENTGET (CAR sel1)))) 0 1)))
	  )
	  (COND
	    ((AND(EQ "LINE" (CDR (ASSOC 0 (ENTGET (CAR sel1)))))(EQ "INSERT" (CDR (ASSOC 0 (ENTGET (CAR sel1))))))
	      (SETQ endp2
		   (POLAR
		     (POLAR (CDR(ASSOC 10(ENTGET(CAR sel1))))
				 (CDR(ASSOC 50(ENTGET(CAR sel1))))
				 (*(CDR(ASSOC 41(ENTGET(CAR sel1))))(CADR(ASSOC 11(ENTGET(CAR sel1)))))
		     )
		     (+(CDR(ASSOC 50(ENTGET(CAR sel1))))(/ PI 2.0))
		     (*(CDR(ASSOC 42(ENTGET(CAR sel1))))(CADDR(ASSOC 11(ENTGET(CAR sel1)))))
		   )
	      )
	     )
	    ((EQ "LINE" (CDR (ASSOC 0 (ENTGET (CAR sel1)))))
	      (SETQ endp2 (TRANS (CDR (ASSOC 11 (ENTGET (CAR sel1)))) 0 1)))
	    ((EQ "VERTEX" (CDR (ASSOC 0 (ENTGET (CAR sel1)))))
	      (SETQ endp2 (TRANS (CDR (ASSOC 10 (ENTGET (ENTNEXT (CAR sel1))))) 0 1))
	     )
	  )
	  (SETQ	lang   (ANGLE endp1 endp2)
		chkang (+ lang (GETVAR "viewtwist"))
		ldist  (DISTANCE (LIST (CAR endp1) (CADR endp1)) endp2)
	  ) ;_ end of setq
	  (IF (AND (> chkang 1.868) (< chkang 5.01))
	    (SETQ tang	(ANGTOS (+ PI lang) 1 4)
		  osang	(+ (* PI 1.5) lang)
	    ) ;_ end of setq
	    (SETQ tang	(ANGTOS lang 1 4)
		  osang	(+ (* PI 0.5) lang)
	    ) ;_ end of setq
	  )				;if
	  (SETQ
	    ltpt  (POLAR endp1
			 lang
			 (DISTANCE (LIST (CAR endp1) (CADR endp1)) tstpt)
		  ) ;_ end of polar
	    ptabv (POLAR ltpt osang (* 1.1 txtht))
	    ptblw (POLAR ltpt (+ osang PI) (* 1.1 txtht))
	    mkdis (/ (DISTANCE (LIST (CAR ltpt) (CADR ltpt)) ptabv) 2)
	  )				;setq
	  (GRDRAW endp1 endp2 -1)
	  (IF (< (DISTANCE (LIST (CAR ptblw) (CADR ptblw)) tstpt)
		 (DISTANCE (LIST (CAR ptabv) (CADR ptabv)) tstpt)
	      ) ;_ end of <
	    (SETQ mrkr1	(POLAR ptblw lang mkdis)
		  mrkr2	(POLAR ptblw (+ lang PI) mkdis)
		  vlis	(LIST 256 mrkr1 mrkr2 256 mrkr2 ltpt 256 ltpt mrkr1)
	    ) ;_ end of setq
	    (SETQ mrkr1	(POLAR ptabv lang mkdis)
		  mrkr2	(POLAR ptabv (+ lang PI) mkdis)
		  vlis	(LIST 256 mrkr1 mrkr2 256 mrkr2 ltpt 256 ltpt mrkr1)
	    ) ;_ end of setq
	  )				;if
	  (GRVECS (EVAL 'vlis))
	  (SETQ
	    txstr (ukword 1
			  "Key-in Select Default"
			  (STRCAT "Key-in, Select or accept Default=<"
				  (IF lstr_txt
				    lstr_txt
				    "nil"
				  ) ;_ end of if
				  ">"
			  ) ;_ end of strcat
			  (IF txstr
			    txstr
			    "Default"
			  ) ;_ end of if
		  ) ;_ end of ukword
	  ) ;_ end of setq
	  (COND
	    ((EQ txstr "Key-in")
	     (SETQ lstr_txt (ustr 1
				  "Enter text"
				  (IF txstr
				    txstr
				    (STRCAT (RTOS ldist) "'")
				  ) ;_ end of if
				  "T"
			    ) ;_ end of ustr
	     ) ;_ end of setq
	    )
	    ((EQ txstr "Default")
	     (IF lstr_txt
	       nil
	       (SETQ lstr_txt "?")
	     ) ;_ end of if
	    )
	    ((EQ txstr "Select")
	     (WHILE (NOT lstr_ent)
	       (SETQ lstr_ent (ENTSEL))
	     ) ;_ end of while
	     (WHILE
	       (NOT (= (CDR (ASSOC 0 (ENTGET (CAR lstr_ent)))) "TEXT"))
		(SETQ
		  lstr_ent (ENTSEL "\nNot a TEXT entity, select again.")
		) ;_ end of setq
	     ) ;_ end of while
	     (SETQ lstr_txt (CDR (ASSOC 1 (ENTGET (CAR lstr_ent)))))
	    )
	  )				;cond
	  (IF (< (DISTANCE (LIST (CAR ptblw) (CADR ptblw)) tstpt)
		 (DISTANCE (LIST (CAR ptabv) (CADR ptabv)) tstpt)
	      ) ;_ end of <
	    (COMMAND ".text" "j" "mc" ptblw txtht tang lstr_txt)
	    (COMMAND ".text" "j" "mc" ptabv txtht tang lstr_txt)
	  )				;if
	  (IF (= txstr "Select")
	    (PROGN
	      (SETQ ent_disp (ukword 1
				     "Keep Erase"
				     "Keep or Erase Selected text?"
				     (IF ent_disp
				       ent_disp
				       "Keep"
				     ) ;_ end of if
			     ) ;_ end of ukword
	      ) ;_ end of setq
	      (IF (= ent_disp "Erase")
		(ENTDEL (CAR lstr_ent))
	      ) ;_ end of if
	    )				;progn
	  )				;if
	  (SETQ	lcolr
		 (CDR
		   (ASSOC 62
			  (TBLSEARCH "layer"
				     (CDR (ASSOC 8 (ENTGET (CAR sel1))))
			  ) ;_ end of tblsearch
		   ) ;_ end of assoc
		 ) ;_ end of cdr
	  ) ;_ end of setq
	  (GRDRAW endp1 endp2 -1)
					;    (grdraw endp1 endp2 lcolr)
					;    (setq vlis (subst '256 '7 vlis))
	  (GRVECS (EVAL 'vlis))
	  (PRINC "\nSelect Line: ")
	)				;progn
    )					;while
  (c:rslayr)
  (getstyle "")
  (SETVAR "OSMODE" oldlstr_osmode)
  (PRINC)
)					;defun
;|«Visual LISP© Format Options»
(72 2 40 2 T "end of " 60 9 2 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;