;====  ARCTEXT.LSP  ====  rev: 12/13/87  ====================================
;      As the name implies, this routine will let you write text on an arc.
;      All your input from each run will become default values for
;      subsequent runs, so you can undo (type "U") and rerun (type "AT"),
;      changing values for character height, radius, or included angle 
;      until spacing looks good.  Any text style should work, but make sure
;      it is loaded with a height of 0.
;
;      This routine is offered as "shareware".  Feel free to use it and copy 
;      it for others.  Please do not delete this header.  If you find that it
;      has been particularly useful and would like to encourage the author in
;      similar endeavors, please send $19.00 to .........  Rich Perlman
;                                                          2409 Amity Avenue
;                                                          Gastonia, NC 28054
;                       For custom programming, call ...  (704) 867-1314
;----------------------------------------------------------------------------
(defun c:at ()            (setvar "cmdecho" 0)   
    (setq st (gtst "\n    Enter string"       st       ""                   )
          ht (gtrl "\n    Character height"   ht       (getvar "textsize")  )
          cp (gtpt "\n    Center of arc"      cp       (list 0.0 0.0)       )
          ra (gtrl "\n    Radius"             ra       0.0                  )
          fd (gtrl "\n    Included angle"     fd       180.0                )
          sl (strlen st)
          fa (/ (* fd pi) -180.0)
          ai (/ fa (- sl 1))
          a0 (/ (- pi fa) 2.0)
          nn 0
          ss1 (ssadd)
    )
    (while (< nn sl)
        (setq ap (+ a0 (* nn ai))
              pt (polar cp ap ra)
              tr (- (/ (* 180.0 ap) pi) 90.0)
              nn (+ nn 1 )
        )
        (command "text" "m" pt ht tr (substr st nn 1))
        (setq ss1 (ssadd (entlast) ss1))
    )
    (setq st st)
)
;----  GETSTRING WITH DEFAULT PROMPT  ---------------------------------------
(defun gtst (prmpt currval dflt / fullstrg)
    (if (equal currval nil) (setq currval dflt))
    (setq response (getstring t (prompt (strcat prmpt " <"  currval ">: "))))
    (if (equal response "") (setq currval currval) response)
)
;----  GETREAL WITH DEFAULT PROMPT  -----------------------------------------
(defun gtrl (prmpt currval dflt / response)
    (if (equal currval nil) (setq currval dflt))
    (setq response (getstring (prompt 
                                 (strcat prmpt " <" (rtos currval) ">: "))))
    (if (equal response "") (setq currval currval) (atof response))
)
;----  GETPOINT WITH DEFAULT PROMPT  ----------------------------------------
(defun gtpt (prmpt currval dflt / response)
    (if (equal currval nil) (setq currval dflt))
    (setq response (getpoint (strcat prmpt " <" (rtos (car currval)) 
                                           "," (rtos (cadr currval)) ">: ")))
    (if (equal response nil) (setq currval currval) response)
)
;============================================================================
(setq z "ArcText.LSP by Rich Perlman, (704) 867-1314.  Type AT to begin.")