我这里有一个小程序,也是在晓东里下载的,虽然简单,可是觉得这种输入方法值得借鉴,还希望高手不要笑话:
 - ;;;==== 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."
- )
|