请教，vl-catch-all-apply方法之后如何判断是esc还是回车？

yx5277 · 发表于 2013-4-17 19:33:15

就是怎么根据vl-catch-all-error-message的返回消息判断是按了esc，还是按了回车、空格或右键，然后分别处理？

检索了一下，没看到用lisp怎么解决这个问题的。

Gu_xl · 发表于 2013-4-17 20:29:51

本帖最后由 Gu_xl 于 2013-4-18 09:19 编辑

请举出具体实例来分析！有很多种方法进行错误处理分析！去参考下我的这篇帖子：
【Gu_xl】Lisp程序设计错误处理的技巧 ...

yx5277 · 发表于 2013-4-17 20:33:40

以下代码来自于
出错处理案例解析 [url]http://bbs.mjtd.com/forum.php?mod=viewthread&tid=85081&fromuid=219579[/url]

;;;错误处理教程-1
(defun c:tt1 (/ varlst var_old var_new)
(defun *error* (inf)
(setq inf (strcase inf t)) ;将出错信息转换为小写字符串
(cond
((wcmatch inf "*break,*cancel*,*exit*,*取消*") ;|按了<Esc>键出错处理|;
(princ "\n用户按了<Esc>强制退出\n")
(mapcar 'setvar varlst var_old)
)
(t ;|其余错误处理|;
(princ (strcat "\n" inf))
(mapcar 'setvar varlst var_old)
)
) ;_ 结束cond
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
) ;_ 结束defun
(vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq varlst '("osmode")
var_new '(0)
var_old (mapcar 'getvar varlst)
) ;_ 结束setq
(mapcar 'setvar varlst var_new)
(princ "\n按<Esc>强制退出, <空格>/<Enter>/<右键>错误...")
(rtos (getreal "\n请输入实数:"));出错后转到内部自定义的*error*函数
(mapcar 'setvar varlst var_old)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
) ;_ 结束defun
;;;错误处理教程-2
(defun c:tt2 (/ err inf varlst var_old var_new)
(vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq err (vl-catch-all-apply
'(lambda ()
(setq varlst '("osmode")
var_new '(0)
var_old (mapcar 'getvar varlst)
) ;_ 结束setq
(mapcar 'setvar varlst var_new)
(princ "\n按<Esc>强制退出, <空格>/<Enter>/<右键>错误...")
(rtos (getreal "\n请输入实数:"))
) ;_ 结束lambda
) ;_ 结束vl-catch-all-apply
) ;_ 结束setq
(if (vl-catch-all-error-p err)
(progn ;|出错处理|;
(setq inf (strcase (vl-catch-all-error-message err) t)) ;将出错信息转换为小写字符串
(cond ((wcmatch inf "*break,*cancel*,*exit*,*取消*") ;|按了<Esc>键出错处理|;
(princ "\n用户按了<Esc>强制退出\n")
(mapcar 'setvar varlst var_old)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(t ;|其余错误处理|;
(princ (strcat "\n" inf))
(mapcar 'setvar varlst var_old)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
) ;_ 结束cond
(princ)
) ;_ 结束progn
(progn ;|程序正常运行完毕的处理|;
(princ "\n")
(mapcar 'setvar varlst var_old)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
) ;_ 结束progn
) ;_ 结束if
) ;_ 结束defun

;;;错误处理教程-1 
(defun c:tt1 (/  varlst var_old var_new) 
  (defun *error* (inf) 
    (setq inf (strcase inf t)) ;将出错信息转换为小写字符串 
    (cond 
         ((wcmatch inf "*break,*cancel*,*exit*,*取消*") ;|按了<Esc>键出错处理|; 
           (princ "\n用户按了<Esc>强制退出\n") 
           (mapcar 'setvar varlst var_old) 
          ) 
        (t ;|其余错误处理|; 
            (princ (strcat "\n" inf)) 
            (mapcar 'setvar varlst var_old) 
        ) 
    ) ;_ 结束cond 
    (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
    (princ) 
  ) ;_ 结束defun 
  (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
  (setq varlst '("osmode") 
           var_new '(0) 
           var_old (mapcar 'getvar varlst) 
  ) ;_ 结束setq 
  (mapcar 'setvar varlst var_new) 
  (princ "\n按<Esc>强制退出, <空格>/<Enter>/<右键>错误...") 
  (rtos (getreal "\n请输入实数:"));出错后转到内部自定义的*error*函数 
  (mapcar 'setvar varlst var_old) 
  (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
  (princ) 
) ;_ 结束defun 
;;;错误处理教程-2 
(defun c:tt2 (/ err inf varlst var_old var_new) 
   (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
   (setq err (vl-catch-all-apply 
                                     '(lambda () 
                                                  (setq varlst  '("osmode") 
                                                          var_new '(0) 
                                                          var_old (mapcar 'getvar varlst) 
                                                    ) ;_ 结束setq 
                                                   (mapcar 'setvar varlst var_new) 
                                                   (princ "\n按<Esc>强制退出, <空格>/<Enter>/<右键>错误...") 
                                                   (rtos (getreal "\n请输入实数:")) 
                                        ) ;_ 结束lambda 
                       ) ;_ 结束vl-catch-all-apply 
  ) ;_ 结束setq 
  (if (vl-catch-all-error-p err) 
          (progn ;|出错处理|; 
            (setq inf (strcase (vl-catch-all-error-message err) t)) ;将出错信息转换为小写字符串 
            (cond ((wcmatch inf "*break,*cancel*,*exit*,*取消*") ;|按了<Esc>键出错处理|; 
            (princ "\n用户按了<Esc>强制退出\n") 
            (mapcar 'setvar varlst var_old) 
            (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
           ) 
           (t ;|其余错误处理|; 
            (princ (strcat "\n" inf)) 
            (mapcar 'setvar varlst var_old) 
            (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
           ) 
            ) ;_ 结束cond 
            (princ) 
          ) ;_ 结束progn 
          (progn ;|程序正常运行完毕的处理|; 
            (princ "\n") 
            (mapcar 'setvar varlst var_old) 
            (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
            (princ) 
          ) ;_ 结束progn 
  ) ;_ 结束if 
) ;_ 结束defun

在上面两个出错处理函数教程中，vl-catch-all-apply方法之后按<Esc>强制退出与<空格>/<Enter>/<右键>都是一同退出，我想加一个判断，如果是按<Esc>就强制退出，按<空格>/<Enter>/<右键>就执行其它代码而不退出，关键是vl-catch-all-apply方法之后如何判断是esc还是回车？

yx5277 · 发表于 2013-4-17 20:38:47

本帖最后由 yx5277 于 2013-4-17 20:41 编辑

Gu_xl 发表于 2013-4-17 20:29
请举出具体实例来分析！有很多种方法进行错误处理分析！去参考下我的这篇帖子：
【Gu_xl】Lisp程序设计错误 ...

超版的帖子我看过，里面提到“简而言之就是使用Vl-Catch-All-Apply对函数进行包装，然后使用Vl-Catch-All-Error-P判断包装函数返回值是否异常，若有异常,可使用Vl-Catch-All-Apply-Error-Message函数输出错误信息,并再此对错误进行处理。”
现在我想知道在Vl-Catch-All-Apply-Error-Message函数输出的错误信息里，如何区分esc和回车？

Gu_xl · 发表于 2013-4-17 20:42:05

yx5277 发表于 2013-4-17 20:33
以下代码来自于
出错处理案例解析 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=85081&fromuid=2195 ...

仔细研读我的帖子，你就会找到答案！

yx5277 · 发表于 2013-4-17 20:49:52

Gu_xl 发表于 2013-4-17 20:42
仔细研读我的帖子，你就会找到答案！

谢谢G版，难道要用*error*方法？恕我愚昧，参不透超版的答案，还请直接明示。可否在板凳的示例代码中添加代码解决？

yx5277 · 发表于 2013-4-17 21:30:55

本帖最后由 yx5277 于 2013-4-17 22:12 编辑

yx5277 发表于 2013-4-17 20:49
谢谢G版，难道要用*error*方法？恕我愚昧，参不透超版的答案，还请直接明示。可否在板凳的示例代码中 ...

我把你的tt6重建了一下，已经把好多的少掉的空格补上了，正在研究.....
直接运行的结果显示，esc和回车都是调用了同一个出错处理函数*error*，该如何让他们调用不同出错处理函数，G版就直接告诉了吧。。。

(defun c:tt6 ()
;; 初始化错误处理,出错后回到初始状态
(gxl-error-init1 (list "cmdecho" 0 "osmode" 0) nil 2)
(setq p1 (getpoint "\n输入直角三角形直角边第一点: "))
(setq p2 (getpoint p1 "\n输入直角三角形直角边第二点: "))
(setq d1 (distance p1 p2))
(vl-cmdf "_line" p1 p2 "")
(setq dd (getdist p1 "\n请输入斜边长度: "))
;;;根据勾股定理计算另一条直角边长度
(setq d2
(VL-CATCH-ALL-APPLY ;_ 捕捉sqrt函数的错误
'sqrt
(list
(- (* dd dd) (* d1 d1))
)
)
)
(if(VL-CATCH-ALL-ERROR-P d2) ;_ 当输入的斜边长度小于直角边长度时sqrt函数会出错
(progn ;_ sqrt 函数结果异常
(alert (VL-CATCH-ALL-ERROR-MESSAGE d2)) ;_ 提示错误信息
(exit) ;_ 制造一个错误退出程序
)
;;;绘制三角形
(progn
(setq ang (+ (angle p1 p2) (* 0.5 pi)))
(command "_line" p2 (polar p2 ang d2) p1 "")
)
)
(gxl-error-end) ;_ 恢复错误处理
(princ)
)
(defun gxl-error-init1 (syslst fun UndoMode / sysname sysvar)
(setq *olderror* *error*
*Function* fun
*UndoMode* UndoMode
)
(defun *error* ( msg / sysname sysvar)
(if (= 2 *UndoMode*)
(progn
(if (= 8 (logand (getvar "undoctl") 8))
(command "_undo" "_e")
)
(command "_U")
)
(progn
(if *sysvarInit*
(while (and (setq sysname (car *sysvarInit*))
(setq sysvar (cadr *sysvarInit*))
)
(setq *sysvarInit* (cddr *sysvarInit*))
(setvar sysname sysvar)
)
)
(if *Function* (VL-CATCH-ALL-APPLY *Function*)) ;_执行函数
(if (= *UndoMode* 1)
(if(= 8 (logand (getvar "undoctl") 8))
(command "_undo" "_e")
)
)
)
)
(setq *error* *olderror*
*olderror* nil
*Function* nil
*UndoMode* nil
)
(or (wcmatch(strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
)
);defun
(if (or (= *UndoMode* 1) (= *UndoMode* 2))
(progn
;;如果有活动编组，先结束编组
(if (= 8 (logand (getvar "undoctl") 8))
(command "_undo" "_e")
)
(command "_undo""_BE") ;_ 编组开始
)
)
(if syslst
(while (and (setq sysname (car syslst))
(setq sysvar (cadr syslst))
)
(setq *sysvarInit*
(append *sysvarInit*
(list sysname (getvar sysname))
)
)
(setq syslst (cddr syslst))
(setvar sysname sysvar)
)
)
(princ)
)
;;(gxl-error-end) 恢复*error*
(defun gxl-error-end()
(if(= 8 (logand (getvar "undoctl") 8))
(command "_undo" "_e")
)
(if *olderror*
(setq *error* *olderror*
*olderror* nil
) ;_ 恢复*error*函数
)
(if *sysvarInit* ;_ 恢复储存的系统变量
(while (and (setq sysname (car *sysvarInit*))
(setq sysvar (cadr *sysvarInit*))
)
(setq *sysvarInit* (cddr *sysvarInit*))
(setvar sysname sysvar)
)
)
(setq *Function* nil
*UndoMode* nil
)
(princ)
)

(defun c:tt6 () 
;; 初始化错误处理,出错后回到初始状态 
        (gxl-error-init1 (list "cmdecho" 0 "osmode" 0) nil 2) 
        (setq p1 (getpoint "\n输入直角三角形直角边第一点: ")) 
        (setq p2 (getpoint p1 "\n输入直角三角形直角边第二点: ")) 
        (setq d1 (distance p1 p2)) 
        (vl-cmdf "_line" p1 p2 "") 
        (setq dd (getdist p1 "\n请输入斜边长度: ")) 
        ;;;根据勾股定理计算另一条直角边长度 
     (setq d2   
        (VL-CATCH-ALL-APPLY ;_ 捕捉sqrt函数的错误 
          'sqrt 
          (list 
            (- (* dd dd) (* d1 d1)) 
          ) 
        ) 
     ) 
   (if(VL-CATCH-ALL-ERROR-P d2) ;_ 当输入的斜边长度小于直角边长度时sqrt函数会出错 
     (progn ;_ sqrt 函数结果异常 
     (alert (VL-CATCH-ALL-ERROR-MESSAGE d2)) ;_ 提示错误信息 
     (exit) ;_ 制造一个错误退出程序 
     ) 
     ;;;绘制三角形 
     (progn 
       (setq ang (+ (angle p1 p2) (* 0.5 pi))) 
       (command "_line" p2 (polar p2 ang d2) p1 "") 
       ) 
     ) 
     (gxl-error-end) ;_ 恢复错误处理 
     (princ) 
     ) 
 
(defun gxl-error-init1 (syslst fun UndoMode / sysname sysvar) 
        (setq *olderror* *error* 
              *Function* fun 
              *UndoMode* UndoMode 
     ) 
     (defun *error* ( msg / sysname sysvar) 
       (if (= 2 *UndoMode*) 
         (progn 
       (if (= 8 (logand (getvar "undoctl") 8)) 
         (command "_undo" "_e") 
       ) 
       (command "_U") 
         ) 
         (progn 
       (if *sysvarInit* 
         (while (and (setq sysname (car *sysvarInit*)) 
                 (setq sysvar (cadr *sysvarInit*)) 
            ) 
           (setq *sysvarInit* (cddr *sysvarInit*)) 
           (setvar sysname sysvar) 
         ) 
       ) 
       (if *Function* (VL-CATCH-ALL-APPLY *Function*)) ;_执行函数 
       (if (= *UndoMode* 1) 
         (if(= 8 (logand (getvar "undoctl") 8)) 
           (command "_undo" "_e") 
         ) 
       ) 
         ) 
       ) 
       (setq *error* *olderror* 
         *olderror* nil 
         *Function* nil 
         *UndoMode* nil 
       ) 
       (or (wcmatch(strcase msg) "*BREAK,*CANCEL*,*EXIT*") 
       (princ (strcat "\n** Error: " msg " **")) 
       ) 
     );defun 
    
     (if (or (= *UndoMode* 1) (= *UndoMode* 2)) 
       (progn 
         ;;如果有活动编组，先结束编组 
         (if (= 8 (logand (getvar "undoctl") 8)) 
       (command "_undo" "_e") 
         ) 
         (command "_undo""_BE") ;_ 编组开始 
       ) 
     ) 
     (if syslst 
       (while (and (setq sysname (car syslst)) 
           (setq sysvar (cadr syslst)) 
          ) 
         (setq *sysvarInit* 
            (append *sysvarInit* 
                (list sysname (getvar sysname)) 
            ) 
         ) 
         (setq syslst (cddr syslst)) 
         (setvar sysname sysvar) 
       ) 
     ) 
     (princ) 
   ) 
 
;;(gxl-error-end) 恢复*error* 
       (defun   gxl-error-end() 
           (if(= 8 (logand (getvar "undoctl") 8)) 
           (command "_undo" "_e") 
         ) 
         (if *olderror* 
           (setq *error* *olderror* 
                 *olderror* nil 
           ) ;_ 恢复*error*函数 
      ) 
      (if *sysvarInit* ;_ 恢复储存的系统变量 
        (while (and (setq sysname (car *sysvarInit*)) 
            (setq sysvar (cadr *sysvarInit*)) 
           ) 
          (setq *sysvarInit* (cddr *sysvarInit*)) 
          (setvar sysname sysvar) 
        ) 
      ) 
      (setq *Function* nil 
            *UndoMode* nil 
      ) 
      (princ) 
     )

复制代码

Gu_xl · 发表于 2013-4-18 08:32:51

本帖最后由 Gu_xl 于 2013-4-18 12:19 编辑

yx5277 发表于 2013-4-17 21:30
我把你的tt6重建了一下，已经把好多的少掉的空格补上了，正在研究.....
直接运行的结果显示，esc和回车都 ...

两点提示：1、不同的错误，*error*函数的错误信息是不同的，这个是判断错误类型的一种方法，根据不同的错误类型进行相应的处理！
2、用VL-CATCH-ALL-APPLY 就地捕捉错误，根据VL-CATCH-ALL-ERROR-MESSAGE函数提供的错误信息来判断错误类型，然后进行相应的处理！
自己体会一下下面的例子：

(defun c:tt (/ *error*)
(defun *error* (s)
(princ "**error提示有错** ")
(princ s) ;_ 按esc退出，打印出错信息
(princ)
)
(setq loop t)
(while loop
(setq p (VL-CATCH-ALL-APPLY 'rtos (list (getreal "\n输入实数:"))))
(if (VL-CATCH-ALL-ERROR-P p)
(princ (strcat "**VL-CATCH-ALL-ERROR-P提示有错：** "
(VL-CATCH-ALL-ERROR-MESSAGE p)
)
) ;_ 按回车或右键，输入错误，打印提示信息
(setq loop nil) ;_ 输入正确，结束while
)
)
(princ)
)

yx5277 · 发表于 2013-4-18 16:47:30

Gu_xl 发表于 2013-4-18 08:32
两点提示：1、不同的错误，*error*函数的错误信息是不同的，这个是判断错误类型的一种方法，根据不同的错 ...

你的办法不错，我想到了用 (if (= 52 (getvar "errno")) 也应该可以解决

yx5277 · 发表于 2013-4-18 17:21:54

真是庸人自扰，学艺不精，板凳里的代码其实已经解决了我的问题

就下面的代码就可以了。

(defun c:tt2 (/ err inf varlst var_old var_new)
(vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq err (vl-catch-all-apply
'(lambda ()
(setq varlst '("osmode")
var_new '(0)
var_old (mapcar 'getvar varlst)
) ;_ 结束setq
(mapcar 'setvar varlst var_new)
(princ "\n按<Esc>强制退出, <空格>/<Enter>/<右键>错误...")
(rtos (getreal "\n请输入实数:"))
) ;_ 结束lambda
) ;_ 结束vl-catch-all-apply
) ;_ 结束setq
(if (vl-catch-all-error-p err)
(progn ;|出错处理|;
(setq inf (strcase (vl-catch-all-error-message err) t)) ;将出错信息转换为小写字符串
(cond
((wcmatch inf "*break,*cancel*,*exit*,*取消*") ;|按了<Esc>键出错处理|;
(princ (strcat "\n用户按了<Esc>强制退出! " inf))
(mapcar 'setvar varlst var_old)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(t ;|其余错误处理|;
(princ (strcat "\n用户按了enter退出! " inf))
(mapcar 'setvar varlst var_old)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
) ;_ 结束cond
(princ)
);_ 结束progn
(progn ;|程序正常运行完毕的处理|;
(princ "\n正常退出!")
(mapcar 'setvar varlst var_old)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
) ;_ 结束progn
) ;_ 结束if
) ;_ 结束defun

(defun c:tt2 (/ err inf varlst var_old var_new) 
   (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
   (setq err (vl-catch-all-apply 
                                     '(lambda () 
                                                  (setq varlst  '("osmode") 
                                                          var_new '(0) 
                                                          var_old (mapcar 'getvar varlst) 
                                                    ) ;_ 结束setq 
                                                   (mapcar 'setvar varlst var_new) 
                                                   (princ "\n按<Esc>强制退出, <空格>/<Enter>/<右键>错误...") 
                                                   (rtos (getreal "\n请输入实数:")) 
                                        ) ;_ 结束lambda 
                       ) ;_ 结束vl-catch-all-apply 
  ) ;_ 结束setq 
  (if (vl-catch-all-error-p err) 
          (progn ;|出错处理|; 
            (setq inf (strcase (vl-catch-all-error-message err) t)) ;将出错信息转换为小写字符串 
            (cond 
              ((wcmatch inf "*break,*cancel*,*exit*,*取消*") ;|按了<Esc>键出错处理|; 
              (princ (strcat "\n用户按了<Esc>强制退出!   " inf)) 
              (mapcar 'setvar varlst var_old) 
              (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
              ) 
              (t ;|其余错误处理|; 
              (princ (strcat "\n用户按了enter退出!   " inf)) 
              (mapcar 'setvar varlst var_old) 
              (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
              ) 
           ) ;_ 结束cond 
           (princ) 
         );_ 结束progn 
         (progn ;|程序正常运行完毕的处理|; 
            (princ "\n正常退出!") 
            (mapcar 'setvar varlst var_old) 
            (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
            (princ) 
         ) ;_ 结束progn 
  ) ;_ 结束if 
) ;_ 结束defun

账号		自动登录	找回密码
密码			注册

[源码] 请教，vl-catch-all-apply方法之后如何判断是esc还是回车？

相关帖子

点评

浏览过的版块