求修改一个程序，改成输入命令的时候提示输入颜色，然后按设置的颜色来设置圆

664571221

求修改一个程序，改成输入命令的时候提示输入颜色，然后按设置的颜色来设置圆

(DEFUN *ERROR* (msg)
  (COMMAND) (COMMAND)
  (PRINC (STRCAT "\n 警告! " "程序已经退出!"))
  (PRINC)
)
(defun c:CZHY ()
(setvar "cmdecho" 0)
(setq stxt (getstring "\n输入标记<屏选> :"))
(if (and (= stxt "")
          (setq s1 (entsel "\n选择标记 :"))
          (setq ent (entget(car s1)))
          (= (cdr(assoc 0 ent)) "TEXT"))
  (setq stxt (cdr(assoc 1 (entget(car s1)))))
)

  (setq ybl (getreal"\n 请输入圆的大小：<右键默认1000>"))
    (if (not ybl )(setq ybl 1000))
    (command "layer" "make" "circle" "c" 1 "circle" "")

(if (setq ss (ssget (list '(0 . "TEXT") (cons 1 (strcat "*" stxt "*"))))) (progn

  (setq i 0)
  (repeat (sslength ss)
   (setq en (ssname ss i))
   (vla-getboundingbox(vlax-ename->vla-object en) 'minp 'maxp)
   (setq minp (vlax-safearray->list minp)
         maxp (vlax-safearray->list maxp))
   (setq pt (polar minp (angle minp maxp) (/ (distance minp maxp) 2)))

    (command ".CIRCLE" pt ybl)
    (setq i(1+ i))
   )
   (princ "\n")
  (princ (list "总共找到" (sslength ss)"处"))
))
  (princ "\n")
(initget 1  " Yes NO")
   (setq yorn(getkword "要删除圆吗？<Yes or No>:"))
  (if (= yorn "Yes")
    (progn
    (setq sss (ssget "x" '((0 . "circle")(8 . "circle"))))
    (command "erase" sss "")
    )
    (if (= yorn "No")(command ""))
    )
  (setvar "CMDECHO" 1)
(princ)
)

lifuq1979

(defun c:CZHY ()
(setvar "cmdecho" 0)
(setq stxt (getstring "\n输入标记<屏选> :"))
(if (and (= stxt "")(= (cdr(assoc 0 (setq ent(entget(car (entsel "\n选择标记 :")))))) "TEXT"))
  (setq stxt (cdr(assoc 1 ent)))
)
  (if (not(setq ybl (getreal"\n 请输入圆的大小：<右键默认1000>")))(setq ybl 1000))
        (if (not(setq color (getint "\n请输入圆的颜色：(1)红 (2)黄 (3)绿 (4)青 (5)蓝 (6)洋红 (7)白 <7>：")))(setq color 7))
(if (setq ss (ssget (list '(0 . "TEXT") (cons 1 (strcat "*" stxt "*")))))
        (progn
  (setq i -1)
  (repeat (sslength ss)
   (setq en (ssname ss (setq i(1+ i))))
   (vla-getboundingbox(vlax-ename->vla-object en) 'minp 'maxp)
   (setq minp (vlax-safearray->list minp)
         maxp (vlax-safearray->list maxp))
   (setq pt (polar minp (angle minp maxp) (/ (distance minp maxp) 2)))
         (entmake (list '(0 . "CIRCLE") (cons 10 pt) (cons 62 color)(cons 8 "circle")(cons 370 30)(cons 40 ybl)))
        )
  (princ (strcat "\n总共找到" (rtos(sslength ss)2 0) "处"))
))
  (initget " Yes NO")
   (setq yorn(getkword "\n要删除圆吗?(Yes/No) <YES>:"))
  (cond
                ((or(= yorn "Yes")(= yorn  nil))
      (setq sss (ssget "x" '((0 . "circle")(8 . "circle"))))
      (command "erase" sss "")
    )
    ((= yorn "No")(command ""))
  )
  (setvar "CMDECHO" 1)
(princ)
)