[LISP函数]：子函数产生错误时，如何避免整个程序的退出？

litss

通常情况下，如果子函数执行过程中出现错误，会导致整个程序自动结束。但并不是每种错误都是不能容忍的。我想知道有没有什么办法可以避免主程序因这些特定的错误而退出呢？一般情况下，子函数出错了会返回什么值呢？还是不返回任何值，而直接调用*error*结束程序啊？

狂刀

返回cad的出错提示
用
catch-all-error-p
(if ...)
等

netbee

若是系统错误，我想可能没有办法，因为系统出错，它就直接调用错误处理函数了。
但一般函数出错都是调用时变量有问题，这里我们可以加一个容错处理点。
在函数开始处用一个变量判断点，来判断传入的变量是否是你需要的变量类型、值范围等。若是则继续，若变量达不到要求，则跳至函数尾并返回一个值（逻辑假或负值。。。等与函数正常值不一样就行）

2. 
   
3. ;;;====================================================
   
4. (defun setclayer (slist / cname cor ctmp tmp lsty)
   
5. ;;出错后帮助提示信息
   
6.   (setq        ctmp (strcat "\n(setclayer '(层名 颜色))！"
   
7.                      "\n(setclayer "轴线")设置当前图层"
   
8.              ) ;_ end of strcat
   
9.   ) ;_ end of setq
   
10. ;;若变量是表则
    
11.   (cond        ((= (type slist) 'LIST)
    
12.          (setq cname (car slist)
    
13.                cor   (cadr slist)
    
14.                lsty (caddr slist)
    
15.          ) ;_ end of setq
    
16.          (if (not lsty)(setq lsty "CONTINUOUS"))
    
17.         )
    
18.         ((= (type slist) 'STR)
    
19.          (setq cname slist)
    
20.         )
    
21.   ) ;_ end of cond
    
22. ;;若是用问号调用则直接显示帮助
    
23.   (cond        ((= slist '?)
    
24.          (alert ctmp)
    
25.         )
    
26. 　　　　　;若变量不是表则。
    
27.         ((not slist)
    
28.          (if clayer_old
    
29.            (setvar "clayer" clayer_old)
    
30.            (setvar "clayer" "0")
    
31.          ) ;_ end of if
    
32.         )
    
33.         ((and cname cor (= (type cname) 'STR) (= (type cor) 'INT))
    
34.          (if (and (tblobjname "LAYER" cname)
    
35.                   (setq tmp (entget (tblobjname "LAYER" cname)))
    
36.              ) ;_ 结束and
    
37.            (progn (setq        tmp (subst (cons 62 cor)
    
38.                                    (assoc 62 tmp)
    
39. 
    
40.                                    tmp
    
41.                             ) ;_ 结束subst
    
42.                         tmp (subst (cons 70 0) (assoc 70 tmp) tmp)
    
43.                   ) ;_ 结束setq
    
44.                   (entmod tmp)
    
45.            ) ;_ 结束progn
    
46.            (entmake (list
    
47.                       '(0 . "LAYER")
    
48.                       '(100 . "AcDbSymbolTableRecord")
    
49.                       '(100 . "AcDbLayerTableRecord")
    
50.                       (cons 6 lsty)
    
51.                       (cons 62 cor)
    
52.                       '(70 . 0)
    
53.                       (cons 2 cname)
    
54.                     ) ;_ end of list
    
55.            ) ;_ end of entmake
    
56. 
    
57.          ) ;_ end of if
    
58.          (setq clayer_old (getvar "clayer"))
    
59.          (setvar "clayer" cname)
    
60.         )
    
61.         ((and (= (type cname) 'STR))
    
62.          (if (setq tmp (entget (tblobjname "LAYER" cname)))
    
63.            (progn (setvar "clayer" cname)
    
64.                   (setq        tmp (subst (cons 62 cor)
    
65.                                    (assoc 62 tmp)
    
66.                                    tmp
    
67.                             ) ;_ 结束subst
    
68.                         tmp (subst (cons 70 0) (assoc 70 tmp) tmp)
    
69.                   ) ;_ 结束setq
    
70.                   (entmod tmp)
    
71.            ) ;_ 结束progn
    
72.            (progn (entmake (list
    
73.                              '(0 . "LAYER")
    
74.                              '(100 . "AcDbSymbolTableRecord")
    
75.                              '(100 . "AcDbLayerTableRecord")
    
76.                              (cons 6 lsty)
    
77.                              (cons 62 7)
    
78.                              '(70 . 0)
    
79.                              (cons 2 cname)
    
80.                            ) ;_ end of list
    
81.                   ) ;_ end of entmake
    
82.            ) ;_ end of progn
    
83.          ) ;_ end of if
    
84.          (setq clayer_old (getvar "clayer"))
    
85.          (setvar "clayer" cname)
    
86.         )
    
87.                      ;;若变量不对，则出现提示
    
88.         (T (progn (alert (strcat "\n数据错误：" ctmp))))
    
89.   ) ;_ end of cond
    
90.   (princ)
    
91. ) ;_ end of defun
    

<br /> ;;;====================================================<br /> (defun setclayer (slist / cname cor ctmp tmp lsty)<br /> ;;出错后帮助提示信息<br />   (setq        ctmp (strcat "\n(setclayer '(层名 颜色))！"<br />                      "\n(setclayer "轴线")设置当前图层"<br />              ) ;_ end of strcat<br />   ) ;_ end of setq<br /> ;;若变量是表则<br />   (cond        ((= (type slist) 'LIST)<br />          (setq cname (car slist)<br />                cor   (cadr slist)<br />                lsty (caddr slist)<br />          ) ;_ end of setq<br />          (if (not lsty)(setq lsty "CONTINUOUS"))<br />         )<br />         ((= (type slist) 'STR)<br />          (setq cname slist)<br />         )<br />   ) ;_ end of cond<br /> ;;若是用问号调用则直接显示帮助<br />   (cond        ((= slist '?)<br />          (alert ctmp)<br />         )<br /> 　　　　　;若变量不是表则。<br />         ((not slist)<br />          (if clayer_old<br />            (setvar "clayer" clayer_old)<br />            (setvar "clayer" "0")<br />          ) ;_ end of if<br />         )<br />         ((and cname cor (= (type cname) 'STR) (= (type cor) 'INT))<br />          (if (and (tblobjname "LAYER" cname)<br />                   (setq tmp (entget (tblobjname "LAYER" cname)))<br />              ) ;_ 结束and<br />            (progn (setq        tmp (subst (cons 62 cor)<br />                                    (assoc 62 tmp)<br /> <br />                                    tmp<br />                             ) ;_ 结束subst<br />                         tmp (subst (cons 70 0) (assoc 70 tmp) tmp)<br />                   ) ;_ 结束setq<br />                   (entmod tmp)<br />            ) ;_ 结束progn<br />            (entmake (list<br />                       '(0 . "LAYER")<br />                       '(100 . "AcDbSymbolTableRecord")<br />                       '(100 . "AcDbLayerTableRecord")<br />                       (cons 6 lsty)<br />                       (cons 62 cor)<br />                       '(70 . 0)<br />                       (cons 2 cname)<br />                     ) ;_ end of list<br />            ) ;_ end of entmake<br /> <br />          ) ;_ end of if<br />          (setq clayer_old (getvar "clayer"))<br />          (setvar "clayer" cname)<br />         )<br />         ((and (= (type cname) 'STR))<br />          (if (setq tmp (entget (tblobjname "LAYER" cname)))<br />            (progn (setvar "clayer" cname)<br />                   (setq        tmp (subst (cons 62 cor)<br />                                    (assoc 62 tmp)<br />                                    tmp<br />                             ) ;_ 结束subst<br />                         tmp (subst (cons 70 0) (assoc 70 tmp) tmp)<br />                   ) ;_ 结束setq<br />                   (entmod tmp)<br />            ) ;_ 结束progn<br />            (progn (entmake (list<br />                              '(0 . "LAYER")<br />                              '(100 . "AcDbSymbolTableRecord")<br />                              '(100 . "AcDbLayerTableRecord")<br />                              (cons 6 lsty)<br />                              (cons 62 7)<br />                              '(70 . 0)<br />                              (cons 2 cname)<br />                            ) ;_ end of list<br />                   ) ;_ end of entmake<br />            ) ;_ end of progn<br />          ) ;_ end of if<br />          (setq clayer_old (getvar "clayer"))<br />          (setvar "clayer" cname)<br />         )<br />                      ;;若变量不对，则出现提示<br />         (T (progn (alert (strcat "\n数据错误：" ctmp))))<br />   ) ;_ end of cond<br />   (princ)<br /> ) ;_ end of defun<br />

这上面就使用了若错误使用变量调用时的容错方式，当调用变量不是我所需要的格式时，将出现提示，之后程序继续执行。
上面的程序是我几年前编的，当时是想能让一个函数使用不同的变量格式调用。
且若变量不对的情况可以继续执行，主要用来调试程序时用，当所有程序调试完后，再将其中判断语句注释掉。
后改正过很多BUG，但源码不在这台机子上。呵呵＾＿＾　

litss

呵呵，谢谢两位的帮助。其实的想要实现的东西没这么复杂：）。netbee斑竹的代码看起来还有点吃力。
我碰到这个问题实际上确实是因为变量格式所导致。我在用ssget时，没法让程序接受键盘输入的字符，象getpiont之类命令一样，initget之后就允许字符输入，作为改变程序下一步操作的关键字。最后我参考别人的方法，做了一个ssget的结果是否为空值的判断，勉强实现了可选择操作。代码如下：
(IF (NULL (SETQ SS1 (SSGET '((-4 . "<OR") (-4 . "<AND")
                                (0 . "TEXT")
                                (1 . "*x")
                                (-4 . "AND>")
                                (-4 . "<AND")
                                (0 . "TEXT")
                                (1 . "*Y*")
                                (-4 . "AND>")
                                (-4 . "<AND")
                                (0 . "TEXT")
                                (1 . "*X*")
                                (-4 . "AND>")
                                (-4 . "OR>")
                               )
                        )
              )
        )  
      (PROGN
.......
       );PROGN
);IF

但这样的结果我还是不太满意。因为它也只能提供两个可选择方式，要么选中物体，执行第一步，要么不选任何物体，直接回车执行第二选择。万一有第三、第四选择，就比较麻烦了：（

还有一个小问题。我自己定义了*error*函数的部分内容，以便恢复一些系统变量。但由于该*error*子函数被释放到内存中，导致每次别的cad自带命令出错时也调用这个自定义的*error*，进而产生更多的错误（说缺少某些变量值。。那些我自己的程序里定义的变量）。不知道大家一般怎么处理的？怎么样在程序用完以后把*error*恢复原样？

eachy

这个一个写了一半的测试程序，想模拟 CAD 中的“刷子”方式。

2. 
   
3. (defun c:tt (/ key ss pt pts ptm)
   
4.   (if (progn (initget 6 "S All CP W WP L F C B G")
   
5.              (setq key (getpoint "\n选择目标实体[设置(S)]: "))
   
6.       )
   
7.     (progn
   
8.       (cond
   
9.         ((= key "ALL")
   
10.          (setq ss (ssget "all"))
    
11.         )
    
12.         ((member (strcat key) '("CP" "WP" "F"))
    
13.          (setq msg "\n第一栏选点: ")
    
14.          (while        (progn (if (and pts (> (length pts) 1) (/= pt "U"))
    
15.                          (grdraw (car pts) (cadr pts) -1)
    
16.                          (if (and pts ptm)
    
17.                            (grdraw (car pts) ptm -1)
    
18.                          )
    
19.                        )
    
20.                        (initget "U")
    
21.                        (setq pt        (if pts
    
22.                                   (getpoint (car pts) msg)
    
23.                                   (getpoint msg)
    
24.                                 )
    
25.                        )
    
26.                 )
    
27.            (if (= (type pt) 'LIST)
    
28.              (setq pts (cons pt pts))
    
29.              (if pts
    
30.                (setq ptm (car pts)
    
31.                      pts (cdr pts)
    
32.                )
    
33.              )
    
34.            )
    
35.            (setq msg "\n指定直线的端点或 [放弃(U)]:")
    
36.          )
    
37.          (if pts
    
38.            (setq ss (ssget key pts))
    
39.          )
    
40.         )
    
41.         (t)
    
42.       )
    
43.     )
    
44.   )
    
45.   ss
    
46. )

<br /> (defun c:tt (/ key ss pt pts ptm)<br />   (if (progn (initget 6 "S All CP W WP L F C B G")<br />              (setq key (getpoint "\n选择目标实体[设置(S)]: "))<br />       )<br />     (progn<br />       (cond<br />         ((= key "ALL")<br />          (setq ss (ssget "all"))<br />         )<br />         ((member (strcat key) '("CP" "WP" "F"))<br />          (setq msg "\n第一栏选点: ")<br />          (while        (progn (if (and pts (> (length pts) 1) (/= pt "U"))<br />                          (grdraw (car pts) (cadr pts) -1)<br />                          (if (and pts ptm)<br />                            (grdraw (car pts) ptm -1)<br />                          )<br />                        )<br />                        (initget "U")<br />                        (setq pt        (if pts<br />                                   (getpoint (car pts) msg)<br />                                   (getpoint msg)<br />                                 )<br />                        )<br />                 )<br />            (if (= (type pt) 'LIST)<br />              (setq pts (cons pt pts))<br />              (if pts<br />                (setq ptm (car pts)<br />                      pts (cdr pts)<br />                )<br />              )<br />            )<br />            (setq msg "\n指定直线的端点或 [放弃(U)]:")<br />          )<br />          (if pts<br />            (setq ss (ssget key pts))<br />          )<br />         )<br />         (t)<br />       )<br />     )<br />   )<br />   ss<br /> )

zhynt

先保存旧的错误函数，再将新的错误函数setq给*error*，最后再程序结束之前再恢复原先保存的错误函数：

(setq olderr *error*)
(setq *error* newerr)
.
.
.
(setq *error* olderr)

aeo

最初由 eachy 发布
[B]这个一个写了一半的测试程序，想模拟 CAD 中的“刷子”方式。
[code]
(defun c:tt (/ key ss pt pts ptm)
  (if (progn (initget 6 "S All CP W WP L F C B G")
             (setq key (getpoint "\n选择目标实体[设置... [/B]

我虽然没写，但也考虑过怎么写:
(ssget ":s")
应该是一句话搞定!

狂刀

(ssget ":s")很好用，可单选，可框选