预设常用填充V1.2——用LISP来快速完成常用填充
本帖最后由 raimo 于 2013-5-8 10:05 编辑经常在明经获得各位的帮助，现在把我自己研究的一个小工具拿出来分享，算是完成一直想回馈论坛的心愿吧
这次的版本我很满意了，应该是最终版，所以我重新整理发帖，方便大家阅读下载。
;;预设常用填充-------------------- TC
;;V1.2 明经raimo 2012.07.30
;;优化代码,去掉拼凑代码重新设计
;;增加记忆功能，提高填充的使用方便性
;;在V1.1的基础上实现点选，与对象选择并存，并且都可以多选。
;;非常感谢ZZXXQQ版主的指点与帮助！！
;;----------------------------------
附个演示动画
attach://69209.swf
LISP源码下载包（内附源码及CAD扩展填充文件）
== 说明 ==
这个工具为快速填充常用图案而设计，比如我们装饰行业制图常用的，玻璃，木地板，地砖，实心墙体。。。
其中一些设置我说明一下
1. 使用命令是TC---填充的意思
2. 数字1-9选择9种常用填充图案，可以根据这个模式自行增减和调整
3. 木地板，木夹板，钢砼..几种填充必须使用我附件里的填充文件才可以用，CAD默认的文件里没有
也可以自己修改源码，设置相应的填充图案
（填充图案需要替换掉系统目录下CAD自带的 acad.pat，acadiso.pat，路径可自行搜索一下，在C盘的）
以前帖子链接：
预设常用填充V1.1——用LISP来快速完成常用填充
http://bbs.mjtd.com/thread-93852-1-1.html
;;预设常用 -------------------- TC
;;V1.2
;;优化代码,去掉拼凑代码重新设计
;;增加记忆功能，提高填充的使用方便性
;;在V1.1的基础上实现点选，与对象选择并存，并且都可以多选。
;;----------------------------------
(defun c:TC (/ opt oldcolor num_HType *num_HType* ss )
(setvar "measurement" 1) ; 设置公制单位
(setvar "cmdecho" 0) ; 关闭命令响应
(setq oldcolor (getvar "cecolor"))
(command "_layer" "m" "4BD-METAL" "c" "201" "" "l" "c" "" "")
(setvar "clayer" "4BD-METAL")
(if *num_HType*
(setq num_HType (getint (strcat "\n选择填充样式①BD玻璃实体 ②BD金属实体 ③拉丝80 ④地砖300 ⑤地砖800 ⑥木地板 ⑦木夹板 ⑧木纹 ⑨钢砼: <" (rtos *num_HType* 2 0) ">")))
(setq num_HType (getint "\n选择填充样式①BD玻璃实体 ②BD金属实体 ③拉丝80 ④地砖300 ⑤地砖800 ⑥木地板 ⑦木夹板 ⑧木纹 ⑨钢砼: " ))
)
(if (not num_HType)
(setq num_HType *num_HType*)
(setq *num_HType* num_HType)
)
(setq opt num_HType)
(if (< 0 opt 10) (eval (read(strcat "(tianchong" (itoa opt) ")"))));根据选项参数执行填充样式
(if (setq ss (ssget))
(command "bhatch" "s" ss "" "") ;如果选择集不为空，则执行对象填充
(progn;如果选择集为空，则执行点选命令
(prompt "\n请拾取填充内部点：\n")
(command "bhatch" pause)
(while (> (getvar "CMDACTIVE") 0) (command PAUSE))
))
(command "color" oldcolor)
(princ)
)
(defun tianchong1 ()
(prompt "\n当前样式: ①BD玻璃实体填充\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(command "color" "131")
(command "bhatch" "p" "solid" "")
)
(defun tianchong2 (/ ss)
(command "_layer" "m" "4BD-METAL" "c" "201" "" "l" "c" "" "")
(prompt "\n当前样式: ②BD金属实体填充\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(command "color" "201")
(setvar "clayer" "4BD-METAL")
(command "bhatch" "p" "solid" "")
(setq ss (entlast))
(COMMAND "CHANGE" SS "" "PROPERTIES" "la" "4BD-METAL" "")
)
(defun tianchong3 ()
(prompt "\n当前样式: ③拉丝间距80\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(command "color" "8")
(command "bhatch" "p" "U" "0" "80" "N" "")
)
(defun tianchong4 ()
(prompt "\n当前样式: ④300x300地砖\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(command "color" "8")
(command "bhatch" "p" "U" "0" "300" "Y" "")
)
(defun tianchong5 ()
(prompt "\n当前样式: ⑤800x800地砖\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(command "color" "8")
(command "bhatch" "p" "U" "0" "800" "Y" "")
)
(defun tianchong6 ()
(prompt "\n当前样式: ⑥灰色木地板\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(command "color" "8")
(command "bhatch" "p" "木地板" "80" "0" "")
)
(defun tianchong7 ()
(prompt "\n当前样式: ⑦暗色木夹板\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(command "color" "250")
(command "bhatch" "p" "木夹板" "1" "0" "")
)
(defun tianchong8 ()
(prompt "\n当前样式: ⑧暗色木纹\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(command "color" "250")
(command "bhatch" "p" "木纹01" "10" "0" "")
)
(defun tianchong9 ()
(prompt "\n当前样式:⑨暗色钢砼\n")
(prompt "\n请选择对象,跳过则为拾取内部点：\n")
(command "color" "250")
(command "bhatch" "p" "钢筋混凝土" "20" "0" "")
)
我的目的是先点选物体，没有点选物体就执行选择物体
改了这两行代码，
但就为什么不行？
(if (setq ss (ssget))
(prompt "\n请拾取填充内部点：\n")
(command "bhatch" pause)
(while (> (getvar "CMDACTIVE") 0) (command PAUSE))
(progn;如果选择集为空，则执行点选命令
(command "bhatch" "s" ss "" "") ;如果选择集不为空，则执行对象填充
))
小毛草 发表于 2020-7-1 11:30
用我改的那一版本基本可以达到了！有20个常用材质！
图层一直改不过来？一直是t填充？
本帖最后由 raimo 于 2012-7-31 00:42 编辑
感谢ZZXXQQ版主的帮助！！是你解决了我一下午都没清除的BUG，还帮我优化了选择代码
也很感谢 dongya1235 ，是你的意见让我这次终于下决心去完善这个工具，
我是菜鸟，很多东西边学边做，连续填充的问题拖了好久，这次终于了结一个心事，真开心 强烈支持楼主。 地板坐个，以表支持 强烈支持楼主..... ....
强烈支持 也可以自己修改源码，设置相应的填充图案
怎么修改 增加相应的填充图案 本帖最后由 raimo 于 2012-7-31 11:42 编辑
spp_wall 发表于 2012-7-31 09:43 static/image/common/back.gif
也可以自己修改源码，设置相应的填充图案
怎么修改 增加相应的填充图案
源码都给你了，怎么改看看不就知道。。
本身程序就很简单，比较一下几个填充图案的变换语句，很容易明白的
真的不错，一般墙体.玻璃.300x300,600x600,实体.梁.地板.木纹这类填充用得最多 哈哈 我前段时间也写了个填充程序，不过是简单的，楼主这下弄的好全，哈哈 太好了 再接再厉，学习了~~