[求助]：我有一个自动标号的程序,但是不能很好的适应图框

ucsicon

我有一个自动标号的程序,但是不能很好的适应图框的大小,也就是说不好改圆的直径和文字的大小,请高手帮忙修改一下,先谢了.




原程序如下
(defun C:GG (/  TXT  LWSS olderr clay sblip osnapp scmde sgrid shl sucsf p1 p2 p3 x y a x1 y1)
  (setq olderr *error*
        *error* clerr)
  (setq scmde (getvar "CMDECHO"))
  ;(command "_.UNDO" "_GROUP")
  (COMMAND"UNDO""M")
  (setq clay (getvar "CLAYER"))
  (setq sblip (getvar "BLIPMODE"))
  (setq osnapp (getvar "OSMODE"))
  (setq sgrid (getvar "GRIDMODE"))
  (setq shl (getvar "HIGHLIGHT"))
  (setq sucsf (getvar "UCSFOLLOW"))
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 512)
  (setvar "GRIDMODE" 0)
  (setvar "UCSFOLLOW" 0)
  
  (setq txt (getREAL "\nEnter number:"))
  (IF (= TXT NIL)(SETQ TXT 0))
  (while (/= LWSS 1)
   
    (setq TXT (1+ TXT))
   (setq p1 (getpoint "\nEnter the first point :"))
   (setq p2 (getpoint "\nEnter the next point :" p1))
   (setq x (- (car p2) (car p1)))
   (setq y (- (cadr p2) (cadr p1)))
   (setq a (atan (/ (abs y) (abs x))))
   (setq y1 (* (sin a) 5))
   (setq x1 (* (cos a) 5))
   (cond ((and (>= x 0)(>= y 0))
            (setq p3 (list (+ (car p2) x1)(+ (cadr p2) y1)))
         )
         ((and (< x 0)(> y 0))
            (setq p3 (list (- (car p2) x1)(+ (cadr p2) y1)))
         )
         ((and (< x 0)(< y 0))
            (setq p3 (list (- (car p2) x1)(- (cadr p2) y1)))
         )
         ((and (> x 0)(< y 0))
            (setq p3 (list (+ (car p2) x1)(- (cadr p2) y1)))
         )
   )
   (SETQ TXT (RTOS TXT))
   (command "donut" 0 1 p1 "")
   (command "line" p1 p2 "")
   (command "circle" p3 5)
   (command "_text" "j" "mc" p3 3.5 0 txt)
    (SETQ TXT (ATOF TXT))
   )
(setvar "BLIPMODE" sblip)              ; Restore saved modes
(setvar "OSMODE" osnapp)
(setvar "GRIDMODE" sgrid)
(setvar "HIGHLIGHT" shl)
(setvar "UCSFOLLOW" sucsf)
(command "_.UNDO" "_E")
(setvar "CMDECHO" scmde)
(setq *error* olderr)               ; Restore old *error* handler
(princ)
)

hhzcfx

感谢楼主精彩贡献

jx2008

改圆的直径和文字的大小不难，很容易的，通过交互方式输入取得相应的值，再赋予半径和自高变量即可