[分享并提问]快速填充lsp

hardthinking

分享并提问：
    自己做的一个lsp填充，附件提供了lsp对应的填充图案文件，copy到CAD搜索路径即可。可根据需要修改成你常用的填充图案，非常方便。
想要改成填充图形可从天正的pat中单独摘出来。天正提供的够多吧？反正我是够用了。
   PS:关联填充对性能影响很大，如卡可取消。
演示：
若避免重影，需点开图片，最大化模式观看

  

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:对应填充文件.rar 
下载次数:189  文件大小:1 KB 
下载权限: 不限 以上  [免费赚D豆]

程序代码如下：

1. ;;说明：填充命令：TC；更改填充比例命令：TCC
   
2. (defun C:TC ()
   
3.    (setvar "cmdecho" 0)       ;;控制回显
   
4.    (setvar "hpassoc" 1)       ;;控制填充图案是否关联(1:是；0:否)
   
5.    (setvar "hpseparate" 1)    ;;控制是否创建独立填充图案(1:是；0:否)
   
6.    (princ "填充什么呢？(1)-素混凝土(2)钢筋混凝土(3)素土夯实");;对应1.pat 2.pat 3.pat等填充图案文件
   
7.    (setq TC_TA (getint));;输入对应数字
   
8.    (if (= nil (tblsearch "layer" "TC(填充)")) (command "layer" "m" "TC(填充)" ""));;创建填充图层
   
9.    (command "clayer" "TC(填充)");;切换至填充图层
   
10.    (command "hpname" TC_TA)  ;;获取填充图案名字
    
11.    (command "hpscale" TC_BL)    ;;获取填充图案比例
    
12.    (princ "************填充开始*************")
    
13.            (command "-BHATCH")   
    
14.    ;;(command "clayer" 0);;此行已注释掉，本意是想重新回到0层，不能实现
    
15.    (princ)
    
16. )
    
17. ;;设置了填充比例的全局变量
    
18. (defun C:TCC ()
    
19.   (initget 4)   ;;规定不能输入负数
    
20.   (setq TC_BL (getint (strcat "\n 请设置填充比例:")))
    
21.   (princ)
    
22.   )

;;说明：填充命令：TC；更改填充比例命令：TCC<br /> (defun C:TC ()<br />    (setvar "cmdecho" 0)       ;;控制回显<br />    (setvar "hpassoc" 1)       ;;控制填充图案是否关联(1:是；0:否)<br />    (setvar "hpseparate" 1)    ;;控制是否创建独立填充图案(1:是；0:否)<br />    (princ "填充什么呢？(1)-素混凝土(2)钢筋混凝土(3)素土夯实");;对应1.pat 2.pat 3.pat等填充图案文件<br />    (setq TC_TA (getint));;输入对应数字<br />    (if (= nil (tblsearch "layer" "TC(填充)")) (command "layer" "m" "TC(填充)" ""));;创建填充图层<br />    (command "clayer" "TC(填充)");;切换至填充图层<br />    (command "hpname" TC_TA)  ;;获取填充图案名字<br />    (command "hpscale" TC_BL)    ;;获取填充图案比例<br />    (princ "************填充开始*************")<br />            (command "-BHATCH")    <br />    ;;(command "clayer" 0);;此行已注释掉，本意是想重新回到0层，不能实现<br />    (princ)<br /> ) <br /> ;;设置了填充比例的全局变量<br /> (defun C:TCC ()<br />   (initget 4)   ;;规定不能输入负数<br />   (setq TC_BL (getint (strcat "\n 请设置填充比例:")))<br />   (princ)<br />   )

问题是：
   如何填充完成之后，回到0图层。我顺序加了一个（command “clayer” 0）后，程序就出错了，提示”; 错误: 函数被取消“。

eachy

(setvar "clayer" "0")

hardthinking

eachy 发表于 2013-8-17 11:40
(setvar "clayer" "0")

谢谢eachy大侠的回答，我改成这句后，填充图案没办法到填充层了，也到0层了。。我把前面填充层那句改成“(setvar "clayer" "TC(填充)")”也无效。

sicky111

(command ".layer" "s" "0" "")

newer

hardthinking 发表于 2013-8-17 11:49
谢谢eachy大侠的回答，我改成这句后，填充图案没办法到填充层了，也到0层了。。我把前面填充层那句改成“ ...

你注释的那个地方加上同用函数库的函数 (XD::DOC:dstop1)

链接：http://www.xdcad.net/forum/thread-668843-1-1.html

然后再(setvar "clayer" 0)

newer

sicky111 发表于 2013-8-17 12:09
(command ".layer" "s" "0" "")

不行的，因为前面是命令bhatch, 所以要一直等到命令结束后，才能进行其他的。

用下通用函数库的: 如果命令激活，等待结束的函数 XD::DOC:dstop1

2. 
   
3. (defun XD::DOC:dstop1 ()
   
4.   (setvar "cmdecho" 1)
   
5.   (while (/= 0 (getvar "cmdactive"))
   
6.     (command pause)
   
7.   )
   
8.   (setvar "cmdecho" 0)
   
9. )
   

<br /> (defun XD::DOC:dstop1 () <br />   (setvar "cmdecho" 1)<br />   (while (/= 0 (getvar "cmdactive")) <br />     (command pause)<br />   ) <br />   (setvar "cmdecho" 0)<br /> ) <br />

hardthinking

newer 发表于 2013-8-17 12:12
不行的，因为前面是命令bhatch, 所以要一直等到命令结束后，才能进行其他的。

用下通用函数库的: 如果 ...

哈，成功了，，而且还知道了“函数发布”的宝库，多哈newer版主啊~~

newer

hardthinking 发表于 2013-8-17 12:16
哈，成功了，，而且还知道了“函数发布”的宝库，多哈newer版主啊~~

是啊，有空多去那地方看看，那是免费的开源的LISP通用函数库， 函数库编译的版本，下载 晓东通用LISP函数库，现在是0806版，函数发布里面精华的都编译进去了,编译的执行起来更快。

newer

hardthinking 发表于 2013-8-17 12:16
哈，成功了，，而且还知道了“函数发布”的宝库，多哈newer版主啊~~

帮你改下程序，用关键字输入函数initget, 这样，你输入其他的就不相应了。


(princ "填充什么呢？(1)-素混凝土(2)钢筋混凝土(3)素土夯实");;对应1.pat 2.pat 3.pat等填充图案文件
   (setq TC_TA (getint));;输入对应数字

-----》改成：

(initget "1 2 3")
(setq tc_ta (getkword "\n填充什么呢？[1-素混凝土/2-钢筋混凝土/3-素土夯实"))

hardthinking

newer 发表于 2013-8-17 12:28
帮你改下程序，用关键字输入函数initget, 这样，你输入其他的就不相应了。

newer真是热心肠~~
我又发现问题，加了 (XD::DOC:dstop1)后，我指定完填充图案，到指定填充范围时，最一开始变成了只能点选内部点了，然后才出现能选对象的选项。选对象时，还变成只能点选，不能框选了，，，，，

hardthinking

1. ;;说明：填充命令：TC；更改填充比例命令：TCC
   
2. (defun C:TC ()
   
3.   (setvar "cmdecho" 0)
   
4.   (setvar "hpassoc" 1)                       ; 控制填充图案是否关联(1:是；0:否)
   
5.   (setvar "hpseparate" 1)               ; 控制是否创建独立填充图案(1:是；0:否)
   
6.   (initget "1 2 3 4 5")
   
7.   (setq TC_TA (getkword "\n填充什么呢？(1)素混凝土/(2)钢筋混凝土/(3)素土夯实/(4)填实/(5)临空墙/(6)(砖墙):"))
   
8.   (if (= nil (tblsearch "layer" "TC(填充)"))
   
9.     (command "layer" "m" "TC(填充)" "")
   
10.   )
    
11.   (command "HpName" TC_TA)               ; 获取设定的填充图案名称
    
12.   (command "HpScale" TC_BL)               ; 获取设定的比例
    
13.   (princ "************填充开始*************")
    
14.   (command "BHATCH" "LA" "TC(填充)")
    
15.   (setvar "clayer" "0")
    
16.   (princ "好好干！领导是不会亏待你的~*************")
    
17.   (princ)
    
18. )
    

;;说明：填充命令：TC；更改填充比例命令：TCC<br /> (defun C:TC ()<br />   (setvar "cmdecho" 0)<br />   (setvar "hpassoc" 1)                       ; 控制填充图案是否关联(1:是；0:否)<br />   (setvar "hpseparate" 1)               ; 控制是否创建独立填充图案(1:是；0:否)<br />   (initget "1 2 3 4 5")<br />   (setq TC_TA (getkword "\n填充什么呢？(1)素混凝土/(2)钢筋混凝土/(3)素土夯实/(4)填实/(5)临空墙/(6)(砖墙):"))<br />   (if (= nil (tblsearch "layer" "TC(填充)"))<br />     (command "layer" "m" "TC(填充)" "")<br />   )<br />   (command "HpName" TC_TA)               ; 获取设定的填充图案名称<br />   (command "HpScale" TC_BL)               ; 获取设定的比例<br />   (princ "************填充开始*************")<br />   (command "BHATCH" "LA" "TC(填充)")<br />   (setvar "clayer" "0")<br />   (princ "好好干！领导是不会亏待你的~*************")<br />   (princ)<br /> )<br />

改好了，虽然功能都实现了，但还是对这个简单lisp有疑问。
1、改的这个没有加入“ 如果命令激活，等待命令结束”的函数，加了的话，它对所有语句都有影响。bhatch都不好用了
2、princ的“填充开始”和“领导不会亏待你的”同时打了出来。后一句难道不应该bhatch完了再出来吗？

newer

hardthinking 发表于 2013-8-17 17:21
改好了，虽然功能都实现了，但还是对这个简单lisp有疑问。
1、改的这个没有加入“ 如果命令激活， ...

你加入那个 命令激活 代码，看看还一起打印出来不。

LISP你用了COMMAND，代码不会停，会继续求值下去的。

hardthinking

newer 发表于 2013-8-17 17:30
你加入那个 命令激活 代码，看看还一起打印出来不。

LISP你用了COMMAND，代码不会停，会继续求值下去 ...

加了那个激活代码，就不一起打出来了。可是他对我前面代码影响太大啊.如果他就能影响一个指定命令就好了。

hardthinking

newer 发表于 2013-8-17 17:30
你加入那个 命令激活 代码，看看还一起打印出来不。

LISP你用了COMMAND，代码不会停，会继续求值下去 ...

newer版主，非常感谢您总是回答我过于简单的问题，以后我一定多翻翻资料再来问问题。少“拿来主义”，多“奉献精神”...

hodnes

不错的插件，谢谢分享~~~~~~~~~~~~