请教，vl-catch-all-apply方法之后如何判断是esc还是回车？
就是怎么根据vl-catch-all-error-message的返回消息判断是按了esc，还是按了回车、空格或右键，然后分别处理？
检索了一下，没看到用lisp怎么解决这个问题的。
本帖最后由 Gu_xl 于 2013-4-18 09:19 编辑
请举出具体实例来分析！有很多种方法进行错误处理分析！去参考下我的这篇帖子：
【Gu_xl】Lisp程序设计错误处理的技巧 ...
以下代码来自于
出错处理案例解析 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=85081&fromuid=219579;;;错误处理教程-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:41 编辑
Gu_xl 发表于 2013-4-17 20:29 static/image/common/back.gif
请举出具体实例来分析！有很多种方法进行错误处理分析！去参考下我的这篇帖子：
【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和回车？ yx5277 发表于 2013-4-17 20:33 static/image/common/back.gif
以下代码来自于
出错处理案例解析 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=85081&fromuid=2195 ...
仔细研读我的帖子，你就会找到答案！ Gu_xl 发表于 2013-4-17 20:42 static/image/common/back.gif
仔细研读我的帖子，你就会找到答案！
谢谢G版，难道要用*error*方法？恕我愚昧，参不透超版的答案，还请直接明示。可否在板凳的示例代码中添加代码解决？ 本帖最后由 yx5277 于 2013-4-17 22:12 编辑
yx5277 发表于 2013-4-17 20:49 static/image/common/back.gif
谢谢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)
)
本帖最后由 Gu_xl 于 2013-4-18 12:19 编辑
yx5277 发表于 2013-4-17 21:30 static/image/common/back.gif
我把你的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)
)
Gu_xl 发表于 2013-4-18 08:32 static/image/common/back.gif
两点提示：1、不同的错误，*error*函数的错误信息 是不同的，这个是判断错误类型的一种方法，根据不同的错 ...
你的办法不错，我想到了用 (if (= 52 (getvar "errno"))也应该可以解决
真是庸人自扰，学艺不精，板凳里的代码其实已经解决了我的问题
就下面的代码就可以了。(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
页:
[1]
2