明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 716|回复: 1

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

[复制链接]
发表于 2018-7-26 10:52 | 显示全部楼层 |阅读模式
求修改一个程序,改成输入命令的时候提示输入颜色,然后按设置的颜色来设置圆

(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)
)


发表于 2018-7-28 10:14 | 显示全部楼层
本帖最后由 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")(= yorn  nil))
      (setq sss (ssget "x" '((0 . "circle")(8 . "circle"))))
      (command "erase" sss "")
    )
    ((= yorn "No")(command ""))
  )
  (setvar "CMDECHO" 1)
(princ)
)
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 05:31 , Processed in 0.172794 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表