[求助]：请求大侠们看看，为什么这段代码有时会出错？

andyhua5240

程序的思路是，从选择中过滤出填充图案，然后刷目标选择中过滤出来的填充图案。
因为在画图的过程中经常要刷填充图案的，但是填充图案往往和边界线在一起，不是很好的选择，这时常用的做法是循环选择，比较的麻烦。所以想做一个lisp来过滤其中选择的填充图案。

但是这个lisp有时能用，有时又不能用，小弟我不知道为什么，怎么解决？烦请大侠们支招，尽量的帮小弟做得完善些？
谢谢！

2. 
   
3.   [FONT=courier new]
   
4. (defun c:cah (/ cm s1 s2)
   
5.   (princ "\n* 格式刷特性匹配Hatch填充图案→|HATCH| *")
   
6.   (setq cm (getvar "cmdecho"))
   
7.   (setq *error* cd_err)
   
8.   (setvar "cmdecho" 1)
   
9.   (princ "\n选择源|HATCH|对象 <退出>:")
   
10.   (if (setq s1 (ssget '((0 . "hatch"))))
    
11.     (progn
    
12.                  (princ "\n选择目标|HATCH|对象 <退出>:")
    
13.                  (if (setq s2 (ssget '((0 . "hatch"))))
    
14.                      (progn
    
15.       (command ".painter" s1 s2 "")
    
16.                      )
    
17.                  )
    
18.     )
    
19.   )
    
20.   (setvar "cmdecho" cm)
    
21.   (princ)
    
22. )
    
23. 
    
24. (defun cd_err (s)
    
25.   (setvar "cmdecho" cm)
    
26.   (command "_.undo" "_e")
    
27. )
    
28.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun c:cah (/ cm s1 s2)<br />   (princ "\n* 格式刷特性匹配Hatch填充图案→|HATCH| *")<br />   (setq cm (getvar "cmdecho"))<br />   (setq *error* cd_err)<br />   (setvar "cmdecho" 1)<br />   (princ "\n选择源|HATCH|对象 <退出>:")<br />   (if (setq s1 (ssget '((0 . "hatch"))))<br />     (progn<br />                  (princ "\n选择目标|HATCH|对象 <退出>:")<br />                  (if (setq s2 (ssget '((0 . "hatch"))))<br />                      (progn<br />       (command ".painter" s1 s2 "")<br />                      )<br />                  )<br />     )<br />   )<br />   (setvar "cmdecho" cm)<br />   (princ)<br /> )<br /> <br /> (defun cd_err (s)<br />   (setvar "cmdecho" cm)<br />   (command "_.undo" "_e")<br /> )<br />   [/FONT]<br />

carrot1983

楼主的程序用了，没问题．．．
但是为了你的几个princ和两个退出．我把程序改的更烂了．，呵呵
[php]
(defun c:tt (/ cm s1 s2 k)
  (princ "\n* 格式刷特性匹配Hatch填充图案→|HATCH| *")
  (setq cm (getvar "cmdecho"))
  (setq *error* cd_err)
  (setvar "cmdecho" 1)
  (setq k 1)
  (while (= k 1)
    (princ "\n选择源|HATCH|对象 <退出>:")
    (setq s1 (ssget '((0 . "hatch"))))
    (if        (null s1)
      (setq k 0)
    )
    (if        s1
      (progn
        (princ "\n选择目标|HATCH|对象 <退出>:")
        (if (setq s2 (ssget '((0 . "hatch"))))
          (progn
            (command ".painter" s1 s2 "")
          )
          (setq k 0)
        )
      )
    )
  )
  (setvar "cmdecho" cm)
  (princ)
)

(defun cd_err (s)
  (setvar "cmdecho" cm)
  (command "_.undo" "_e")
)

[/php]

xyp1964

;;; 网络U盘下载通用函数xyplib.vlx

2. [FONT=courier new](defun c:cah (/ cm s1 s2)
   
3.   (cmdla0)
   
4.   (if (and (setq s1 (car (entsel "\n选择源|HATCH|对象 <退出>:")))
   
5.            (= (xyp-get-dxf 0 s1) "HATCH")
   
6.       )
   
7.     (progn
   
8.       (princ "\n选择目标|HATCH|对象 <退出>:")
   
9.       (if (setq s2 (ssget '((0 . "HATCH"))))
   
10.         (command ".painter" s1 s2 "")
    
11.       )
    
12.     )
    
13.   )
    
14.   (cmdla1)
    
15. )[/FONT]

[FONT=courier new](defun c:cah (/ cm s1 s2)<br />   (cmdla0)<br />   (if (and (setq s1 (car (entsel "\n选择源|HATCH|对象 <退出>:")))<br />            (= (xyp-get-dxf 0 s1) "HATCH")<br />       )<br />     (progn<br />       (princ "\n选择目标|HATCH|对象 <退出>:")<br />       (if (setq s2 (ssget '((0 . "HATCH"))))<br />         (command ".painter" s1 s2 "")<br />       )<br />     )<br />   )<br />   (cmdla1)<br /> )[/FONT]

carrot1983

呵呵．．．第一次选择确实没必要用多选．．．
晕了．．

雨箭风刀

[php]
(defun c:cah (/ cm s1 s2)
  (princ "\n* 格式刷特性匹配Hatch填充图案→|HATCH| *")
  (setq cm (getvar "cmdecho"))
  (setq *error* cd_err)
  (setvar "cmdecho" 1)
  (while (and (princ "\n选择源|HATCH|对象 <退出>:")
              (setq s1 (ssget ":s" '((0 . "hatch")))))
      (princ "\n选择目标|HATCH|对象 <退出>:")
      (if (setq s2 (ssget '((0 . "hatch"))))
        (progn
          (command ".painter" s1 s2 "")
        )
      )
  )
  (setvar "cmdecho" cm)
  (princ)
)

(defun cd_err (s)
  (setvar "cmdecho" cm)
  (command "_.undo" "_e")
)
[/php]

carrot1983

呵呵，又忘了，可以在and里面一起用的．．．虽然会用，但总会忘用了．
谢谢高手．．学习了．．