1993063 发表于 2013-12-7 22:31 static/image/common/back.gif
;;这个更通用一点的
(Defun C:tt (/ en i ss ty)
(setq *th* (ureal 1 "" "文字高度" *th*))
命令: tt ; 错误: no function definition: UREAL
我目前的需求是有预先定义数值，然后还能输入，已经足够用了，非常感谢！
1993063 发表于 2013-12-7 22:31 static/image/common/back.gif
;;这个更通用一点的
(Defun C:tt (/ en i ss ty)
(setq *th* (ureal 1 "" "文字高度" *th*))
有预定义的数值+可输入已经足够用了，谢谢你！
本帖最后由 1993063 于 2013-12-7 04:47 编辑
半听可乐 发表于 2013-12-7 04:43 static/image/common/back.gif
命令: tt ; 错误: no function definition: UREAL
我目前的需求是有预先定义数值，然后还能输入，已经 ... UREAL 这个函数不是已经告诉你地址了么?
要预先定义的话,加一句 (or *th* (setq *th* 300)) ;300是字高 就搞定了
半听可乐 发表于 2013-12-7 22:38 static/image/common/back.gif
万分感谢你和“1993063”这位朋友，你们的程序都完全满足我的需求，你的这个更灵活些，惊喜！
小改，调整为全局函数版(所谓的记忆功能)(defun c:ty(/ ss en e txth1 dr1)
(prompt "\n请选择需要统一直径与字高的圆、文字:")
(if (setq ss(ssget '((0 . "*text,circle"))))
(progn
(or dr (setq dr 150))
(or txth (setq txth 300))
(or (and (setq dr1(getreal(strcat "\n输入统一圆的直径值<"(if dr (rtos dr 2 2) "150")">:")))(setq dr dr1)))
(or (and (setq txth1(getreal(strcat "\n输入统一的文字高度值<"(if txth (rtos txth 2 2) "300")">:")))(setq txth txth1)))
(while (setq en(ssname ss 0))
(setq e(entget en))
(cond
((wcmatch (cdr(assoc 0 e)) "*TEXT" )(entmod (subst (cons 40 txth) (assoc 40 e) e)))
((wcmatch (cdr(assoc 0 e)) "CIRCLE" )(entmod (subst (cons 40 (* dr 0.5)) (assoc 40 e) e)))
)
(setq ss(ssdel en ss))
)
)
(princ "\n Noting !!!")
)
(princ)
)
1993063 发表于 2013-12-7 22:39 static/image/common/back.gif
没事儿堆堆码
其实我在写去掉圆内圆的，刚巧看到这个帖子，先写的这个，都是没事练练思路。。。
如何清除园内圆
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=108624&fromuid=338795
额，我写个就当练习练习，有什么错误还请莫怪！(defun c:tt( / en i lx name)
(setq en (ssget '((0 . "*text,circle"))))
(setq i 0)
(repeat (sslength en)
(setq name (ssname en i))
(setq lx (cdr (assoc 0 (entget name))))
(cond
((= lx "TEXT") (entmod (subst (cons 40 300) (assoc 40 (entget name)) (entget name))));双引号中的英文一定要大写！！！?
((= lx "MTEXT") (entmod (subst (cons 40 300) (assoc 40 (entget name)) (entget name))));双引号中的英文一定要大写！！！?
((= lx "CIRCLE") (entmod (subst (cons 40 75) (assoc 40 (entget name)) (entget name))));双引号中的英文一定要大写！！！?
)
(setq i (1+ i))
)
)
312735894 发表于 2013-12-7 23:36 static/image/common/back.gif
额，我写个就当练习练习，有什么错误还请莫怪！
很开心大家来各显神通
edata 发表于 2013-12-7 23:14 static/image/common/back.gif
小改，调整为全局函数版(所谓的记忆功能)
朋友，如果我想增加个图层识别功能怎么改呢？即只希望修改指定图层中的文字和圆，指定的图层在程序中预先定义好，程序运行时预定义图层之外的图元不被选择，有劳了
代替cond
...
(entmod (subst (cons 40 (if (= lx "CIRCLE") 75 300) (assoc 40 (entget name)) (entget name))))
...
ZZXXQQ 发表于 2013-12-8 10:02 static/image/common/back.gif
代替cond
...
(entmod (subst (cons 40 (if (= lx "CIRCLE") 75 300) (assoc 40 (entget name)) (entge ...
大侠们一下子奉献了这么多的好作品，小弟略晕，Z版主这点睛之笔是要画在哪里呢？