LISP. Отрисовка числа в круге.

;******** NKRUG.LSP *******************************************
;         Программа вставки числа в кружке.
;         Для шрифта romans.shx не более 2 цифр.
;         Если шрифт arial.ttf, то может влезть и 3 цифры.
;         Можно вводить и буквы.
;         Разработал Владимир Громов 2005 г.
;
(defun C:NKRUG ( / c hold ht r tt txt1 txt)
       (setvar "cmdecho" 0)
       (princ "\n Прежняя высота текста:  ")
       (setq hold (getvar "TEXTSIZE"))
       (princ hold)
       (initget 6)
       (princ (strcat "\n РАЗМЕР (высота) текста <" (rtos hold 2 2) ">: "))
       (setq ht (getreal))
       (if (= ht nil) (setq ht hold))
       (setq r (* 1.2 ht))
       (setq tt 0)
(while tt
       (setq tt (getpoint "\n Укажите ТОЧКУ (ENTER-Хватит): "))
     (if tt
       (progn
       (if (null txt1) (setq txt1 "1"))
       (princ (strcat "\n Число <" txt1 ">: "))
       (setq txt (getstring))
       (if (= txt "") (setq txt txt1))
       (command "_CIRCLE" tt r)
       (command "_TEXT" "_M" tt ht "0" txt)
       (setq txt1 (itoa (1+ (atoi txt))))
     )); progn, if
); while
       (princ "\n Конец. ")
       (princ)
)

^C^C^P(if (not C:NKRUG) (load "nkrug")) NKRUG

;******** NKRUG.LSP *******************************************
;         Программа вставки числа в кружке.
;         Для шрифта romans.shx не более 2 цифр.
;         Если шрифт arial.ttf, то может влезть и 3 цифры.
;         Можно вводить и буквы.
;         Разработал Владимир Громов 2005 г.
;
(defun C:NKRUG ( / c hold ht r tt txt1 txt pt blk *error*)
    (defun *error* (message)
      (princ message)(if blk (entdel blk))(princ))
       (setvar "cmdecho" 0)(setvar "expert" 5)
       (command "_.POINT" "0,0")
       (command "_.regenall")
       (entdel (entlast))
       (princ "\n Прежняя высота текста:  ")
       (setq hold (getvar "TEXTSIZE"))
       (princ hold)
       (initget 6)
       (princ (strcat "\n РАЗМЕР (высота) текста <" (rtos hold 2 2) ">: "))
       (setq ht (getreal))
       (if (= ht nil) (setq ht hold))
       (setq r (* 1.2 ht))
       (setq tt 0)
       (command "_CIRCLE" "0,0" r)
       (command "_.-block" "TMPBLK" "0,0" (entlast) "")
       (command "_-INSERT" "TMPBLK" "0,0" "" "" "")
       (setq blk (entlast) pt (getvar "LASTPOINT"))
(while  tt
  (princ "\n Укажите ТОЧКУ (ENTER-Хватит): ")
  (command "_.CHANGE" blk "" "" pause "")
  (setq tt (getvar "LASTPOINT"))
  (if (equal tt pt 0.000001)
    (progn
      (entdel blk)
      (setq tt nil))
    (progn
       (if (null txt1) (setq txt1 "1"))
       (princ (strcat "\n Число <" txt1 ">: "))
       (setq txt (getstring))
       (if (= txt "") (setq txt txt1))
       (command "_CIRCLE" tt r)
       (command "_TEXT" "_M" tt ht "0" txt)
       (setq txt1 (itoa (1+ (atoi txt))) pt (getvar "LASTPOINT"))))); while
       (princ "\n Конец. ")
       (princ))

(defun test (/ *error* adoc blk blk_name attr)
  (defun *error* (msg)
    (vla-purgeall adoc)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if (not (tblobjname "block" (setq blk_name "CircleMark")))
    (progn
      (setq blk
             (vla-add (vla-get-blocks adoc) (vlax-3d-point '(0. 0. 0.)) blk_name)
            ) ;_ end of setq
      (vla-addcircle blk (vlax-3d-point '(0. 0. 0.)) 3.)
      (setq attr (vla-addattribute
                   blk
                   2.5
                   acattributemodenormal
                   "Значение"
                   (vlax-3d-point '(0. 0. 0.))
                   "value"
                   ""
                   ) ;_ end of vla-AddAttribute
            ) ;_ end of setq
      (vla-put-alignment attr acalignmentmiddlecenter)
      (vla-put-insertionpoint attr (vlax-3d-point '(0. 0. 0.)))
      (vlax-for sub blk
        (vla-put-layer sub "0")
        (vla-put-lineweight sub aclnwtbyblock)
        (vla-put-color sub 0)
        (vla-put-linetype sub "byblock")
        (vla-put-normal sub (vlax-3d-point '(0. 0. 1.)))
        ) ;_ end of vlax-for
      ) ;_ end of progn
    ) ;_ end of if
  (vl-catch-all-apply
    '(lambda ()
       (command "_.-insert" blk_name)
       (while (/= (logand (getvar "cmdactive") 31) 0)
         (command pause)
         ) ;_ end of while
       ) ;_ end of lambda
    ) ;_ end of vl-catch-all-apply
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun