PICKAUTO=1了，还是不能交叉窗口选择对象，是pause问题吗？

artken

帮忙看看这段程序。
按S后的选择跟PICKAUTO=0时的选择一样，就是点空白地方不能自动用交叉窗口选择。可是明明PICKAUTO=1了

2. ;;;;下面是定义填充范围
3. (defun getarea() (while (/= 0 (getvar "cmdactive"))(princ "\n 指定PboHatch内部点或 [选择对象(S)]:")(command pause)))
5. ;;;;下面是定义填充好后自动改到正确图层
6. (defun hatchcly () (while (/= 0 (getvar "cmdactive"))(command pause))(if (not (tblsearch "layer" "!0-hatch"))(command "-layer" "n" "!0-hatch" "c" "8""!0-hatch"""))(if (not (equal entmp1 (entlast)))(command ".CHPROP" "L" "" "LA" "!0-hatch" "")(princ "填充失败!"))(princ))
7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8. (defun C:ht1  ()(setq entmp1 (entlast))(command "-hatch" "p" "!amberina" "1" "0" (getarea))(hatchcly));

;;;;下面是定义填充范围 (defun getarea() (while (/= 0 (getvar "cmdactive"))(princ "\n 指定PboHatch内部点或 [选择对象(S)]:")(command pause))) ;;;;下面是定义填充好后自动改到正确图层 (defun hatchcly () (while (/= 0 (getvar "cmdactive"))(command pause))(if (not (tblsearch "layer" "!0-hatch"))(command "-layer" "n" "!0-hatch" "c" "8""!0-hatch"""))(if (not (equal entmp1 (entlast)))(command ".CHPROP" "L" "" "LA" "!0-hatch" "")(princ "填充失败!"))(princ)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun C:ht1  ()(setq entmp1 (entlast))(command "-hatch" "p" "!amberina" "1" "0" (getarea))(hatchcly));

我不会编程，望大家指教。
现在的情况就是：
1、输入命令HT1后，默认点选内部，这个没问题，问题在于，按S后，选择对象时只能一个一个地去选，不是交叉窗口选择。跟PICKAUTO=0时的情况一样，可是已经设置PICKAUTO=1了。
2、如果只是执行

2. (command "-hatch" "p" "!amberina" "1" "0" )

(command "-hatch" "p" "!amberina" "1" "0" )

其它代码不要。就完全没问题（即默认是点选内部，按S后是交叉窗口选择对象）

不知我表达清楚没
应该怎么改啊。望指点。。。

caoyin

看看 PICKDRAG 的值是否为 0

artken

 ICKDRAG 也是0

配置如下：

 

这里面的配置全都反复试过了，包括各种组合下

caoyin

我看了一下你的程序，不是系统变量的问题

pause还是少用为好

artken

caoyin大侠

那应该怎么改啊。能指点一下吗？

我要实现的功能就是自动填充（按设置好的比例、角度进行填充，填充完的图层是对的，且不改变当前工作图层）

感谢啊。。。

caoyin

2. (defun C:ht1 (/ pick entmp1 laytmp)
3.   (initget "Sel")
4.   (setq pick (getpoint "\n指定PboHatch内部点或 [选择对象(S)]: "))
5.   (if (= pick "Sel")
6.     (setq pick (ssget))
7.   )
8.   (if pick
9.     (progn
10.       (setq entmp1 (entlast)
11.             laytmp (getvar "clayer")
12.       )
13.       (if (not (tblsearch "layer" "!0-hatch"))
14.         (command "_.layer" "_n" "!0-hatch" "c" "8" "!0-hatch" "")
15.       )
16.       (setvar "clayer" "!0-hatch")
17.       (if (vl-consp pick)
18.         (command "_.-hatch" "_p" "AR-SAND" "1" "0" pick "")
19.         (command "_.-hatch" "_p" "AR-SAND" "1" "0" "_s" pick "" "")
20.       )
21.       (if (equal entmp1 (entlast))
22.         (princ "填充失败!")
23.       )
24.       (setvar "clayer" laytmp)
25.     )
26.   )
27.   (princ)
28. )

(defun C:ht1 (/ pick entmp1 laytmp)   (initget "Sel")   (setq pick (getpoint "\n指定PboHatch内部点或 [选择对象(S)]: "))   (if (= pick "Sel")     (setq pick (ssget))   )   (if pick     (progn       (setq entmp1 (entlast)             laytmp (getvar "clayer")       )       (if (not (tblsearch "layer" "!0-hatch"))         (command "_.layer" "_n" "!0-hatch" "c" "8" "!0-hatch" "")       )       (setvar "clayer" "!0-hatch")       (if (vl-consp pick)         (command "_.-hatch" "_p" "AR-SAND" "1" "0" pick "")         (command "_.-hatch" "_p" "AR-SAND" "1" "0" "_s" pick "" "")       )       (if (equal entmp1 (entlast))         (princ "填充失败!")       )       (setvar "clayer" laytmp)     )   )   (princ) )

artken

非常感谢
不过好像有点问题。无法运行
我改了一点，我不懂，可能是瞎改。改完可以运行。但图层的无法自换。好像在这段代码里，感觉有很多代码都没执行到。
我改动如下：
１。大侠原代码中有一个地方有个笔误，多了一个双引号
２。为方便调试，我将填充图案的名称改为系统内置的AR-SAND，这样方便有好心人帮忙试一下
３。原来的两行(command pick "")、(command pick　""  "")　我改为(command pick)、(command pick)了，不然运行不了
我改后的代码如下：能再帮忙看看吗？

2. (defun C:ht1 (/ pick entmp1 laytmp)
3.   (initget "Sel")
4.   (setq pick (getpoint "\n指定PboHatch内部点或 [选择对象(S)]: "))
5.   (if (= pick "Obj")
6.     (setq pick (ssget))
7.   )
8.   (if pick
9.     (progn
10.       (setq entmp1 (entlast)
11.             laytmp (getvar "clayer")
12.       )
13.       (if (not (tblsearch "layer" "!0-hatch"))
14.         (command "_.layer" "_n" "!0-hatch" "c" "8" "!0-hatch" "")
15.       )
16.       (setvar "clayer" "!0-hatch")
17.       (command "_.-hatch" "_p" "ar-sand" "1" "0")
18.       (if (vl-consp pick)
19.         (command pick)
20.         (command pick)
21.       )
22.       (if (equal entmp1 (entlast))
23.         (princ "填充失败!")
24.       )
25.       (setvar "clayer" laytmp)
26.     )
27.   )
28.   (princ)
29. )

(defun C:ht1 (/ pick entmp1 laytmp)   (initget "Sel")   (setq pick (getpoint "\n指定PboHatch内部点或 [选择对象(S)]: "))   (if (= pick "Obj")     (setq pick (ssget))   )   (if pick     (progn       (setq entmp1 (entlast)             laytmp (getvar "clayer")       )       (if (not (tblsearch "layer" "!0-hatch"))         (command "_.layer" "_n" "!0-hatch" "c" "8" "!0-hatch" "")       )       (setvar "clayer" "!0-hatch")       (command "_.-hatch" "_p" "ar-sand" "1" "0")       (if (vl-consp pick)         (command pick)         (command pick)       )       (if (equal entmp1 (entlast))         (princ "填充失败!")       )       (setvar "clayer" laytmp)     )   )   (princ) )

caoyin

已修改，我在CAD2009上测试通过

artken

非常感谢