求修改一个程序，改成输入命令的时候提示输入颜色，然后按设置的颜色来设置圆
求修改一个程序，改成输入命令的时候提示输入颜色，然后按设置的颜色来设置圆(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 于 2018-7-28 11:58 编辑
(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")(= yornnil))
(setq sss (ssget "x" '((0 . "circle")(8 . "circle"))))
(command "erase" sss "")
)
((= yorn "No")(command ""))
)
(setvar "CMDECHO" 1)
(princ)
)
页:
[1]