本帖最后由 raimo 于 2012-6-26 07:51 编辑
发布个我改好的v1.1版本给大家用
已经在我力所能及的范围内
重新设计并优化了代码，删除了原有拼凑部分，增加了记忆功能，提高使用方便性
谢谢大家的回复及使用，希望能对你的工作有一点小帮助
同时附上扩展过的填充文件，这样就不用改代码直接使用我预设好的填充图案了，直接覆盖掉CAD原有默认填充文件即可
（注意：如果你没用我附件里的填充文件，“木地板，木夹板，钢砼，木纹”几个无法使用，但你还是可以参照我的方法，自行修改代码为你自己常用的其他填充图案）
===========================
更新版本v1.1 请下载最新附件
;;V1.1 明经raimo 2012.06.06
;;1.优化代码,去掉拼凑代码重新设计
;;2.增加记忆功能，提高填充的使用方便性
;;3.使用附件里我的填充文件，就可以直接使用预设好的填充（直接覆盖掉CAD原有默认填充文件）
;; 否则“木地板，木夹板，钢砼，木纹”几个无法使用，但可以自行修改为其他填充
;;4.预设常用填充--------------------命令:TC
===========================
经常在明经获得 各位的帮助，现在把我自己研究出来的一个小工具拿出来分享，算是完成一直想回馈论坛的心愿吧
这个工具主要方便快速使用一些常用的填充比如我们装饰行业制图常用的，玻璃，木地板，地砖，实心墙体。。。
这里的一些设置我说明一下
1. 使用命令是TC ---填充的意思
2. 选择数字来选择7种常用填充图案，可以根据这个模式自行增减
3. 木地板，木夹板，钢砼..几种填充是我扩充的填充文件里自带的，CAD默认的没有，可以自己根据情况设置相应的填充名字
4. 这里有几种我自己摸索出来的填充方法。CAD里的三种填充模式都可以找到对应的，也就是可以自行设置出自己的常用填充来，比较实用，所以我才想拿出来与大家分享，希望能有点帮助。
CAD里的三种填充模式
原帖地址：
http://bbs.mjtd.com/thread-93819-1-1.html
同时感谢某位不知名的朋友
因为这里面 MycadGetkword 函数是借用网上搜资料时发现的某段选择用的子程序，我没动脑子就直接拿来用了。。
 - ;;V1.0 明经raimo 2012.05.30
- ;;预设常用填充--------------------TC
- (defun c:TC (/ opt pt la)
- (setvar "measurement" 1) ; 设置公制单位
- (setvar "cmdecho" 0) ; 关闭命令响应
- (setq opt (mycadgetkword "\n①玻璃 ②地砖300 ③地砖800 ④木地板 ⑤实体 ⑥木夹板 ⑦钢砼：<1>"'("1" "2" "3" "4" "5" "6" "7") "1"))
- (cond
- ((= opt "1")(tianchong1))
- ((= opt "2")(tianchong2))
- ((= opt "3")(tianchong3))
- ((= opt "4")(tianchong4))
- ((= opt "5")(tianchong5))
- ((= opt "6")(tianchong6))
- ((= opt "7")(tianchong7)))
- (princ))
-
- (defun tianchong1 ()
- (prompt "\n玻璃比例400,指定内部点\n")
- (setq pt (getpoint))
- (setq oldcolor (getvar "cecolor"))
- (command "color" "8")
- (command "bhatch" "p" "AR-RROOF" "400" "45" pt "")
- (command "color" oldcolor)
- (princ)
- )
- (defun tianchong2 ()
- (prompt "\n300x300地砖,指定内部点\n")
- (setq pt (getpoint))
- (setq oldcolor (getvar "cecolor"))
- (command "color" "8")
- (command "bhatch" "p" "U" "0" "300" "Y" pt "")
- (command "color" oldcolor)
- (princ)
- )
- (defun tianchong3 ()
- (prompt "\n800x800地砖,指定内部点\n")
- (setq pt (getpoint))
- (setq oldcolor (getvar "cecolor"))
- (command "color" "8")
- (command "bhatch" "p" "U" "0" "800" "Y" pt "")
- (command "color" oldcolor)
- (princ)
- )
- (defun tianchong4 ()
- (prompt "\n灰色木地板,指定内部点\n")
- (setq pt (getpoint))
- (setq oldcolor (getvar "cecolor"))
- (command "color" "8")
- (command "bhatch" "p" "木地板" "80" "0" pt "")
- (command "color" oldcolor)
- (princ)
- )
- (defun tianchong5()
- (prompt "\n灰色实体填充,指定内部点\n")
- (setq pt (getpoint))
- (setq oldcolor (getvar "cecolor"))
- (command "color" "8")
- (command "bhatch" "p" "solid" pt "")
- (command "color" oldcolor)
- (princ)
- )
- (defun tianchong6 ()
- (prompt "\n暗色木夹板,指定内部点\n")
- (setq pt (getpoint))
- (setq oldcolor (getvar "cecolor"))
- (command "color" "250")
- (command "bhatch" "p" "木夹板" "1" "0" pt "")
- (command "color" oldcolor)
- (princ)
- )
- (defun tianchong7 ()
- (prompt "\n暗色钢砼,指定内部点\n")
- (setq pt (getpoint))
- (setq oldcolor (getvar "cecolor"))
- (command "color" "250")
- (command "bhatch" "p" "钢筋混凝土" "20" "0" pt "")
- (command "color" oldcolor)
- (princ)
- )
- (defun MycadGetkword(pro lst def / kw val)
- (setq lst (apply 'append (mapcar '(lambda(e) (list (ascii (strcase e)) (ascii (strcase e T)))) lst)) def (ascii def))
- (prompt pro)
- (while (not (and (setq kw (grread nil) val (car kw) kw (cadr kw)) (member val '(2 11 25))
- (if (or (= val 25) (and (= val 11) (= kw 0)) (member kw '(13 32))) (setq kw def) (member kw lst)))))
- (strcase (vl-list->string (list kw))))
-
| 
[复制链接]
发表于 2012-5-30 08:09:53
置顶卡
变色卡
显身卡
楼主
(defun tianchong4 ()