#2
You can try the lisp routine below - seems to work o.k.

;;; r.k. mcswain 1998
(defun checkforfixed ()
(if (= (setq txthgt (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
0
)
(setq txthgt (getdist "\nText height: ")
cmd '(command "TEXT" "C" txtp txthgt txtang char)
)
(setq cmd '(command "TEXT" "C" txtp txtang char)
)
)
)
;;; ---------------------------------------------------------------------
(defun mkblk (/ ins_pt num ss1 i n)
(entmake (list '(0 . "BLOCK") '(2 . "*U") '(70 . 1) (cons 10 midp)))
(setq ss1 alid)
(setq i (sslength ss1))
(setq n (- 1))
(repeat i
(entmake (cdr (entget (ssname ss1 (setq n (1+ n))))))
)
(setq num (entmake '((0 . "ENDBLK"))))
(command "._erase" ss1 "")
(entmake (list '(0 . "INSERT") (cons 2 num) (cons 10 midp)))
(setq lastent (entget (entlast)))
(setq rname (regapp "CTX"))
(if (= rname nil)
(setq rname "CTX")
)
(setq exdata (list '(1002 . "}")))
(setq exdata (cons (cons 1000 orent) exdata))
(setq exdata (cons (cons 1010 midp) exdata))
(setq exdata (cons (cons 1040 radi) exdata))
(setq exdata (cons (cons 1010 radp) exdata))
(setq exdata (cons '(1002 . "{") exdata))
(setq exdata (cons rname exdata))
(setq exdata (list -3 exdata))
(setq elist (cons exdata lastent))
(entmod elist)
(setq bill (entlast))
(princ)
)
;;; ---------------------------------------------------------------------
(defun angtoc (ang)
(setq ang (rtos (atof (angtos ang 0 8)) 2 6))
(strcat "<<" ang)
)
;;; ---------------------------------------------------------------------
(defun roro (item / ypoint pnta1)
(setq fset (ssadd bill))
(setq ypoint (trans (cdr (assoc 10 (entget item))) 0 1))
(setq pnta1 radp)
(setvar "CMDECHO" 1)
(command "._rotate" fset "" pnta1 "_r" pnta1 ypoint pause)
(setvar "CMDECHO" 0)
)
;;; ---------------------------------------------------------------------

(defun errorhandler (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(setq *error* olderr)
(princ)
)

(defun mainf (arg1)
(setq olderr *error*)
(setq *error* errorhandler)
(if (= (getvar "worlducs") 0)
(progn
(setq flagme "T")
(command "._ucs" "w")
)
)
(setvar "CMDECHO" 0)
(setq start (ssadd))
(setq radp (getpoint "\nPick radius point: "))
(setq midp (getpoint "\nPick middle point of text: " radp))
(if (or
(= arg nil)
(= arg1 "")
)
(setq txt (getstring "\nText: " t))
(setq txt arg1)
)
(setq radi (distance radp midp))
(setq txtlen (strlen txt))
(setq txtspc (cdr (assoc 41 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
(checkforfixed)
(setq orent (strcase (getstring "\nIs base of text towards radius point <Y>: "))
)
(curvework radp radi midp orent cmd)
)
(defun curvework (radp radi midp orent cmd)
(if (or
(= orent "")
(= orent "Y")
)
(setq radi2 (- radi (/ txthgt 2)))
(setq radi2 (+ radi (/ txthgt 2)))
)
(setq arclen (* txtlen txtspc txthgt)
arclen (* 0.9 arclen)
txtspc (/ arclen txtlen)
arcang (/ arclen radi2)
sang (- (+ (angle radp midp) (/ arcang 2)) (/ txtspc radi 2))
count 1
)
(repeat txtlen
(if (or
(= orent "")
(= orent "Y")
)
(setq txtang (angtoc (- sang (/ pi 2)))
txtpos count
)
(setq txtang (angtos (- sang (* pi 1.5)) 0)
txtpos (- (1+ txtlen) count)
)
)
(setq txtp (polar radp sang radi))
(setq char (substr txt txtpos 1))
(eval cmd)
(setq alid (ssadd (entlast) start))
(setq count (1+ count))
(setq sang (- sang (/ txtspc radi)))
)
(mkblk)
(roro bill)
(if (= flagme "T")
(command "ucs" "p")
)
(princ)
)

;;; ---------------------------------------------------------------------
;;; main function
(defun c:ctext ()
(mainf "")
)