Err_Routines

eachy · 发表于 2013-7-20 08:51:50

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;;出错处理例程
;; (catch-error <Protected> <OnError>)
;;
;; (catch-error
;; '(lambda () <code to protect>...)
;; '(lambda (error) <error handling code>...)
;; )
;;
;; A wrapper for vl-catch-all-xxxxxxx
;;
;; This function provides a high-level exception-handling
;; construct that allows the programmer to factor out some
;; of the testing and flow control required when using the
;; vl-catch-all-xxxxx functions directly (which is messy).
;;
;; (catch-error) takes two arguments, both of which are
;; quoted function names or lambda lists:
;;
;; <Protected> is a function that takes no arguments
;; (usually a lambda list). It is evaluated, and if an
;; error occurs during its evaluation, then <OnError> is
;; called and passed the error string.
;;
;; <OnError> is a function that is called only if an error
;; occurs during the evaluation of <Protected>. In that case,
;; the message returned by (vl-catch-all-error-message) is
;; passed to <OnError> as its only argument.
;;
;; If no error occurs during evaluation of <Protected>, then
;; (catch-error) returns the result of <Protected>. If an error
;; occurs during evaluation of <Protected>, then (catch-error)
;; returns the result of <OnError> if supplied. If an error
;; occurs and <OnError> is not supplied (e.g., nil), then
;; (catch-error) returns the Visual LISP error object that
;; triggered the error.
;;
;; By default, errors are always handled. The only way to
;; re-raise the error is to call (exit) from within <OnError>,
;; and is generally what should be done in cases where the
;; error is unknown or the code in the <OnError> error handler
;; is not equipped to deal with a particular type of error.
;;
;; Note that calls to (catch-error) can be nested, such that
;; if a nested call does not handle an error (by calling exit
;; or vl-exit-with-error), then one or more outer calls can
;; also examine and/or handle the error, with the caveat that
;; the error message is not the same as the original one, if
;; you use (exit). If you use (vl-exit-with-error), then the
;; error message is correct, but in that case the outer most
;; call to (catch-all) must handle the error because it cannot
;; call (exit) to invoke the *error* function.
;;
;; In essence, you can think of each call to
;; catch error to be a temporary and locally-bound
;; redefinition of the *error* function (where the
;; <OnError> argument represents the body of *error*),
;; with the added benefit of being able to resume
;; execution if desired.
;;
;;
;; Example:
;;
;; The following code obtains a point or the
;; option keyword "foo", and traps the error
;; that occurs if the user responds with the
;; option keyword.
;;
;; If the error is not a result of the user
;; entering the keyword, then something else
;; has gone wrong. In that case, the error
;; handler displays the error message, and
;; aborts by calling (exit).
;;
;; If no error occurs, then the error handler
;; is not called, and the user-supplied point
;; is assigned to Result
;;
;; (defun C:CATCH-ERROR-TEST ()
;;
;; (setq eKeyWordInput
;; "Automation Error. User input is a keyword"
;; )
;;
;; (setq Util
;; (vla-get-utility
;; (vla-get-activeDocument
;; (vlax-get-acad-object)
;; )
;; )
;; )
;;
;;
;; (vla-InitializeUserInput Util 0 "Foo")
;;
;; (setq result
;; (catch-error
;; '(lambda ()
;; (vla-Getpoint
;; Util nil "Enter point/Foo: "
;; )
;; )
;; '(lambda (error)
;; (if (eq error eKeyWordInput)
;; (vla-GetInput Util)
;; (progn
;; (alert (strcat "Error: " errmsg))
;; (exit)
;; )
;; )
;; )
;; )
;; )
;;
;; (if (eq (type Result) 'Str)
;; (princ "\nUser entered 'FOO'")
;; (princ "\nUser entered a point")
;; )
;;
;; (princ)
;;
;; )
;;
(defun thisdrawing ()
(vlax-get-property (vlax-get-acad-object) 'activedocument)
)
(defun catch-error (catch:Protected catch:OnError / catch:err)
(setq catch:err (vl-catch-all-apply catch:Protected))
(if (and (vl-catch-all-error-p catch:err) catch:OnError)
(Apply catch:OnError (list (vl-catch-all-error-message catch:err)))
catch:err
) ;_ end of if
) ;_ end of defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun DefaultOnError (s) ;by Qiu Feng
(if
(not (member s '("Function cancelled" "console break" "quit / exit abort")))
(princ (strcat "\nError: " s))
)
(princ)
)
;;;ChangeVars
;;;修改指定系统变量并返回其先前值
;;;参数
;;;一个包含要更改的系统变量和他们的新值的点对列表
;;;示例
;;;(setq ret (changevars '(("filedia" . 0)("cmdecho" . 0)("osmode" . 512))))
;;;注意
;;;CHANGEVARS 返回一个包含所有指定的系统变量和他们先前值的列表。要恢复他们，可简单地将该返回的列表提供给CHANGEVARS 函数。
(defun changevars (lst)
(mapcar '(lambda (x / tmp var)
(setq tmp (cons (car x)
(if (= (type (setq var (getvar (car x)))) 'list)
(list var)
var
)
)
) ;_ end of setq
(setvar (car x)
(if (= (type (cdr x)) 'list)
(cadr x)
(cdr x)
)
)
tmp
) ;_ end of lambda
lst
) ;_ end of mapcar
) ;_ end of defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Error routine.
;;;
(defun ai_error (s) ; If an error (such as CTRL-C) occurs
(if (not (member s '("Function cancelled" "console break")))
(princ (strcat "\nError: " s))
)
(vla-endundomark (thisdrawing)) ; Deal with UNDO
(if old_error
(setq *error* old_error)
) ; Restore old *error* handler
(if old_cmd
(setvar "cmdecho" old_cmd)
) ; Restore cmdecho value
(princ)
)
;;; ====================================================================
;;; 出错处理包装函数： ErrorWrap
;;; 用法： (ErrorWrap MainFunction SysVariableListToProtect ErrorHandle)
;;; 例如： (ErrorWrap 'mymain '("osmode" "clayer" "highlight") 'myhandle)
;;; 如果没有给出errorhandle, 则用一个默认的处理程序代替
;;; 完整示例：
;;; (defun c:testErrorWrap ()
;;; (ErrorWrap
;;; '(lambda (/ pt1 pt2 pt3) ; main program function
;;; (setvar "osmode" 0)
;;; (setvar "orthomode" 0)
;;; (setq pt1 (getpoint "specify point 1:"))
;;; (setq pt2 (getpoint pt1 "specify point 2:"))
;;; (setq pt3 (getpoint pt2 "specify point 3:"))
;;; (command "_line" pt1 pt2 pt3 "close")
;;; )
;;; '("osmode" "orthomode") ; system variable to protect
;;; '(lambda (s) ; error handle, nil for default
;;; (alert (strcat "错误：" s))
;;; )
;;; )
;;; )
;;; 默认的出错处理函数为
;;; (defun DefaultOnError (s)
;;; (if
;;; (not (member s
;;; '("Function cancelled"
;;; "console break"
;;; "quit / exit abort"
;;; )
;;; )
;;; )
;;; (princ (strcat "\nError: " s))
;;; )
;;; (princ)
;;; )
;;; 说明：此函数在 Visual LISP 的下运行
;;; 作者：秋枫，19-Sep-02
;;; ====================================================================
(defun ErrorWrap (EW:Main EW:SysVarList EW:OnError /
undo_on undo_off undo_push undo_pop
undo_setting undo_init catch-error DefaultOnError
modes moder mlst old_cmd
)
(defun catch-error (catch:Protected catch:OnError / catch:err)
(setq catch:err (vl-catch-all-apply catch:Protected))
(if (and (vl-catch-all-error-p catch:err) catch:OnError)
(Apply catch:OnError (list (vl-catch-all-error-message catch:err)))
catch:err
) ;_ end of if
) ;_ end of defun
(defun DefaultOnError (s) ;by Qiu Feng
(if
(not (member s '("Function cancelled" "console break" "quit / exit abort"))
)
(princ (strcat "\nError: " s))
)
(princ)
)
(defun modes (a)
(setq MLST nil)
(repeat (length a)
(setq MLST (append MLST (list (list (car a) (getvar (car a))))))
(setq a (cdr a))
)
)
(defun moder ()
(repeat (length MLST)
(setvar (caar MLST) (cadar MLST))
(setq MLST (cdr MLST))
)
)
;; ErrorWrap Main
;; ====================================
(setq old_cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(modes EW:SysVarList)
(vla-startundomark (thisdrawing))
(setvar "cmdecho" old_cmd)
(if EW:OnError
(catch-error EW:Main EW:OnError)
(catch-error EW:Main 'DefaultOnError)
)
(setvar "cmdecho" 0)
(vla-endundomark (thisdrawing))
(moder)
(setvar "cmdecho" old_cmd)
(princ)
;; ====================================
)

;;;出错处理例程 
 
;; (catch-error <Protected> <OnError>) 
;; 
;; (catch-error 
;;   '(lambda () <code to protect>...) 
;;   '(lambda (error) <error handling code>...) 
;; ) 
;; 
;; A wrapper for vl-catch-all-xxxxxxx 
;; 
;; This function provides a high-level exception-handling 
;; construct that allows the programmer to factor out some 
;; of the testing and flow control required when using the 
;; vl-catch-all-xxxxx functions directly (which is messy). 
;; 
;; (catch-error) takes two arguments, both of which are 
;; quoted function names or lambda lists: 
;; 
;; <Protected> is a function that takes no arguments 
;; (usually a lambda list). It is evaluated, and if an 
;; error occurs during its evaluation, then <OnError> is 
;; called and passed the error string. 
;; 
;; <OnError> is a function that is called only if an error 
;; occurs during the evaluation of <Protected>. In that case, 
;; the message returned by (vl-catch-all-error-message) is 
;; passed to <OnError> as its only argument. 
;; 
;; If no error occurs during evaluation of <Protected>, then 
;; (catch-error) returns the result of <Protected>. If an error 
;; occurs during evaluation of <Protected>, then (catch-error) 
;; returns the result of <OnError> if supplied. If an error 
;; occurs and <OnError> is not supplied (e.g., nil), then 
;; (catch-error) returns the Visual LISP error object that 
;; triggered the error. 
;; 
;; By default, errors are always handled. The only way to 
;; re-raise the error is to call (exit) from within <OnError>, 
;; and is generally what should be done in cases where the 
;; error is unknown or the code in the <OnError> error handler 
;; is not equipped to deal with a particular type of error. 
;; 
;; Note that calls to (catch-error) can be nested, such that 
;; if a nested call does not handle an error (by calling exit 
;; or vl-exit-with-error), then one or more outer calls can 
;; also examine and/or handle the error, with the caveat that 
;; the error message is not the same as the original one, if 
;; you use (exit). If you use (vl-exit-with-error), then the 
;; error message is correct, but in that case the outer most 
;; call to (catch-all) must handle the error because it cannot 
;; call (exit) to invoke the *error* function. 
;; 
;; In essence, you can think of each call to 
;; catch error to be a temporary and locally-bound 
;; redefinition of the *error* function (where the 
;; <OnError> argument represents the body of *error*), 
;; with the added benefit of being able to resume 
;; execution if desired. 
;; 
;; 
;; Example: 
;; 
;;   The following code obtains a point or the 
;;   option keyword "foo", and traps the error 
;;   that occurs if the user responds with the 
;;   option keyword. 
;;    
;;   If the error is not a result of the user 
;;   entering the keyword, then something else 
;;   has gone wrong. In that case, the error 
;;   handler displays the error message, and 
;;   aborts by calling (exit). 
;;    
;;   If no error occurs, then the error handler 
;;   is not called, and the user-supplied point 
;;   is assigned to Result 
;; 
;; (defun C:CATCH-ERROR-TEST () 
;;    
;;   (setq eKeyWordInput 
;;      "Automation Error. User input is a keyword" 
;;   ) 
;;    
;;   (setq Util 
;;      (vla-get-utility 
;;         (vla-get-activeDocument 
;;            (vlax-get-acad-object) 
;;         ) 
;;      ) 
;;   ) 
;;    
;; 
;;   (vla-InitializeUserInput Util 0 "Foo") 
;;    
;;   (setq result 
;;      (catch-error 
;;       '(lambda () 
;;            (vla-Getpoint 
;;               Util nil "Enter point/Foo: " 
;;            ) 
;;         ) 
;;       '(lambda (error) 
;;           (if (eq error eKeyWordInput) 
;;              (vla-GetInput Util) 
;;              (progn 
;;                 (alert (strcat "Error: " errmsg)) 
;;                 (exit) 
;;              ) 
;;           ) 
;;        ) 
;;     ) 
;;   ) 
;;         
;;   (if (eq (type Result) 'Str) 
;;      (princ "\nUser entered 'FOO'") 
;;      (princ "\nUser entered a point") 
;;   ) 
;;    
;;   (princ) 
;; 
;; ) 
;;               
(defun thisdrawing () 
    (vlax-get-property (vlax-get-acad-object) 'activedocument) 
) 
(defun catch-error (catch:Protected catch:OnError / catch:err) 
  (setq catch:err (vl-catch-all-apply catch:Protected)) 
  (if (and (vl-catch-all-error-p catch:err) catch:OnError) 
    (Apply catch:OnError (list (vl-catch-all-error-message catch:err))) 
    catch:err 
  ) ;_ end of if 
) ;_ end of defun 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 
(defun DefaultOnError (s)        ;by Qiu Feng 
  (if 
    (not (member s '("Function cancelled" "console break" "quit / exit abort"))) 
     (princ (strcat "\nError: " s)) 
  ) 
  (princ) 
) 
 
;;;ChangeVars 
;;;修改指定系统变量并返回其先前值 
;;;参数 
;;;一个包含要更改的系统变量和他们的新值的点对列表 
;;;示例 
;;;(setq ret (changevars '(("filedia" . 0)("cmdecho" . 0)("osmode" . 512)))) 
;;;注意 
;;;CHANGEVARS 返回一个包含所有指定的系统变量和他们先前值的列表。要恢复他们，可简单地将该返回的列表提供给CHANGEVARS 函数。 
(defun changevars (lst) 
  (mapcar '(lambda (x / tmp var) 
         (setq tmp (cons (car x) 
                 (if (= (type (setq var (getvar (car x)))) 'list) 
                   (list var) 
                   var 
                 ) 
               ) 
         ) ;_ end of setq 
         (setvar (car x) 
             (if (= (type (cdr x)) 'list) 
               (cadr x) 
               (cdr x) 
             ) 
         ) 
         tmp 
       ) ;_ end of lambda 
      lst 
  ) ;_ end of mapcar 
) ;_ end of defun 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 
;;; 
;;;  Error routine. 
;;; 
(defun ai_error    (s)            ; If an error (such as CTRL-C) occurs 
  (if (not (member s '("Function cancelled" "console break"))) 
    (princ (strcat "\nError: " s)) 
  ) 
  (vla-endundomark (thisdrawing))            ; Deal with UNDO 
  (if old_error 
    (setq *error* old_error) 
  )                    ; Restore old *error* handler 
  (if old_cmd 
    (setvar "cmdecho" old_cmd) 
  )                    ; Restore cmdecho value 
  (princ) 
) 
 
 
;;; ==================================================================== 
;;; 出错处理包装函数： ErrorWrap 
;;; 用法： (ErrorWrap MainFunction SysVariableListToProtect ErrorHandle) 
;;; 例如： (ErrorWrap 'mymain '("osmode" "clayer" "highlight") 'myhandle) 
;;; 如果没有给出errorhandle, 则用一个默认的处理程序代替 
;;; 完整示例： 
;;; (defun c:testErrorWrap () 
;;;   (ErrorWrap 
;;;     '(lambda (/ pt1 pt2 pt3)        ; main program function 
;;;        (setvar "osmode" 0) 
;;;        (setvar "orthomode" 0) 
;;;        (setq pt1 (getpoint "specify point 1:")) 
;;;        (setq pt2 (getpoint pt1 "specify point 2:")) 
;;;        (setq pt3 (getpoint pt2 "specify point 3:")) 
;;;        (command "_line" pt1 pt2 pt3 "close") 
;;;      ) 
;;;     '("osmode" "orthomode")        ; system variable to protect 
;;;     '(lambda (s)            ; error handle, nil for default 
;;;        (alert (strcat "错误：" s)) 
;;;      ) 
;;;   ) 
;;; ) 
;;; 默认的出错处理函数为 
;;; (defun DefaultOnError (s) 
;;;   (if 
;;;     (not (member s 
;;;          '("Function cancelled" 
;;;            "console break" 
;;;            "quit / exit abort" 
;;;           ) 
;;;      ) 
;;;     ) 
;;;      (princ (strcat "\nError: " s)) 
;;;   ) 
;;;   (princ) 
;;; ) 
;;; 说明：此函数在 Visual LISP 的下运行 
;;; 作者：秋枫，19-Sep-02 
;;; ==================================================================== 
(defun ErrorWrap (EW:Main    EW:SysVarList EW:OnError    / 
          undo_on    undo_off      undo_push        undo_pop 
          undo_setting    undo_init     catch-error   DefaultOnError 
          modes        moder          mlst        old_cmd 
         ) 
   
  (defun catch-error (catch:Protected catch:OnError / catch:err) 
    (setq catch:err (vl-catch-all-apply catch:Protected)) 
    (if    (and (vl-catch-all-error-p catch:err) catch:OnError) 
      (Apply catch:OnError (list (vl-catch-all-error-message catch:err))) 
      catch:err 
    ) ;_ end of if 
  ) ;_ end of defun 
 
  (defun DefaultOnError    (s)        ;by Qiu Feng 
    (if 
      (not (member s '("Function cancelled" "console break" "quit / exit abort")) 
      ) 
       (princ (strcat "\nError: " s)) 
    ) 
    (princ) 
  ) 
 
  (defun modes (a) 
    (setq MLST nil) 
    (repeat (length a) 
      (setq MLST (append MLST (list (list (car a) (getvar (car a)))))) 
      (setq a (cdr a)) 
    ) 
  ) 
 
  (defun moder () 
    (repeat (length MLST) 
      (setvar (caar MLST) (cadar MLST)) 
      (setq MLST (cdr MLST)) 
    ) 
  ) 
 
  ;; ErrorWrap Main 
  ;; ==================================== 
  (setq old_cmd (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
  (modes EW:SysVarList) 
  (vla-startundomark (thisdrawing)) 
  (setvar "cmdecho" old_cmd) 
  (if EW:OnError 
    (catch-error EW:Main EW:OnError) 
    (catch-error EW:Main 'DefaultOnError) 
  ) 
  (setvar "cmdecho" 0) 
  (vla-endundomark (thisdrawing)) 
  (moder) 
  (setvar "cmdecho" old_cmd) 
  (princ) 
  ;; ==================================== 
)

/db_自贡黄明儒_ · 发表于 2013-7-20 09:12:10

总之，我觉得搞得很复杂，尽管错误处理是必要的。
我是在自定义函数内部，重新定义(defun *error* () ...)，这样很简单，可否？

Free-Lancer · 发表于 2013-7-20 09:34:23

/db_自贡黄明儒_ 发表于 17 分钟前

 登录/注册后可看大图

总之，我觉得搞得很复杂，尽管错误处理是必要的。
我是在自定义函数内部，重新定义(defun *error* () ...)，这样很简单，可否？

catch的优点是其包裹的语句即使内部出现错误或中断仍旧执行后面的语句，这样对程序结构就可以简单化来自: Android客户端

/db_自贡黄明儒_ · 发表于 2013-7-20 13:29:34

Free-Lancer 发表于 2013-7-20 09:34
catch的优点是其包裹的语句即使内部出现错误或中断仍旧执行后面的语句，这样对程序结构就可以简单化

为什么函数ErrorWrap定义有那么多局部变量？

/db_自贡黄明儒_ · 发表于 2013-7-20 15:17:37

本帖最后由 /db_自贡黄明儒_ 于 2013-7-20 15:18 编辑

eachy一锅端上来，看起来费劲

;; ====================================================出错处理包装函数
;; 出错处理包装函数： ErrorWrap
;; 用法： (ErrorWrap MainFunction SysVariableListToProtect ErrorHandle)
;; 例如： (ErrorWrap 'mymain '("osmode" "clayer" "highlight") 'myhandle)
;; 如果没有给出errorhandle, 则用一个默认的处理程序代替
;; 完整示例：
;|(defun c:w1 ()
(ErrorWrap
'(lambda (/ pt1 pt2 pt3) ; main program function
(setvar "osmode" 0)
(setvar "orthomode" 0)
(setq pt1 (getpoint "specify point 1:"))
(setq pt2 (getpoint pt1 "specify point 2:"))
(setq pt3 (getpoint pt2 "specify point 3:"))
(command "_line" pt1 pt2 pt3 "close")
)
'("osmode" "orthomode") ; 保护的系统变量
'(lambda (s) ; error handle, nil for default
(alert (strcat "错误：" s))
)
)
)|;
(defun ErrorWrap (EW:Main EW:SysVarList EW:OnError / *DOC* OLD_CMD SYSVARLIST)
;;1 (catch-error 不带参数的函数出错处理函数)
(defun catch-error (catch:Protected catch:OnError / catch:err)
(setq catch:err (vl-catch-all-apply catch:Protected))
(if (and (vl-catch-all-error-p catch:err) catch:OnError)
(Apply catch:OnError
(list (vl-catch-all-error-message catch:err))
)
catch:err
)
)
;;2 默认的出错处理函数为
(defun DefaultOnError (s) ;by Qiu Feng
(if
(not
(member s
'("Function cancelled" "console break" "quit / exit abort")
)
)
(princ (strcat "\nError: " s))
)
(princ)
)
;;3 a为函数EW:Main中改变了的变量列表,如'("osmode" "orthomode"),返回(("osmode" 6311) ("orthomode" 0))
(defun modes (a / MLST)
(repeat (length a)
(setq MLST (append MLST (list (list (car a) (getvar (car a))))))
(setq a (cdr a))
)
)
;;4 根据变量列表，恢复变量
(defun moder (MLST)
(repeat (length MLST)
(setvar (caar MLST) (cadar MLST))
(setq MLST (cdr MLST))
)
)
;;5 (setq ret (changevars '(("filedia" . 0)("cmdecho" . 0)("osmode" . 512))))
;;返回一个包含所有指定的系统变量和他们先前值的列表。要恢复他们，可简单地将该返回的列表提供给CHANGEVARS 函数
(defun changevars (lst / TMP VAR X)
(mapcar '(lambda (x / tmp var)
(setq tmp (cons (car x)
(if (= (type (setq var (getvar (car x)))) 'list)
(list var)
var
)
)
)
(setvar (car x)
(if (= (type (cdr x)) 'list)
(cadr x)
(cdr x)
)
)
tmp
)
lst
)
)
;;6 本程序主函数
(vl-load-com)
(setq *doc* (vlax-get-property (vlax-get-acad-object) 'activedocument))
(setq old_cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq SysVarList (modes EW:SysVarList))
(vla-startundomark *doc*)
(setvar "cmdecho" old_cmd)
(if EW:OnError
(catch-error EW:Main EW:OnError)
(catch-error EW:Main 'DefaultOnError)
)
(setvar "cmdecho" 0)
(vla-endundomark *doc*)
(moder SysVarList)
(setvar "cmdecho" old_cmd)
(princ)
)
;; ====================================================出错处理包装函数

;; ====================================================出错处理包装函数 
;; 出错处理包装函数： ErrorWrap 
;; 用法： (ErrorWrap MainFunction SysVariableListToProtect ErrorHandle) 
;; 例如： (ErrorWrap 'mymain '("osmode" "clayer" "highlight") 'myhandle) 
;; 如果没有给出errorhandle, 则用一个默认的处理程序代替 
;; 完整示例： 
;|(defun c:w1 () 
  (ErrorWrap 
    '(lambda (/ pt1 pt2 pt3)                          ; main program function 
       (setvar "osmode" 0) 
       (setvar "orthomode" 0) 
       (setq pt1 (getpoint "specify point 1:")) 
       (setq pt2 (getpoint pt1 "specify point 2:")) 
       (setq pt3 (getpoint pt2 "specify point 3:")) 
       (command "_line" pt1 pt2 pt3 "close") 
     ) 
    '("osmode" "orthomode")                          ; 保护的系统变量 
    '(lambda (s)                                  ; error handle, nil for default 
       (alert (strcat "错误：" s)) 
     ) 
  ) 
)|; 
 
(defun ErrorWrap (EW:Main EW:SysVarList        EW:OnError / *DOC* OLD_CMD SYSVARLIST) 
  ;;1 (catch-error 不带参数的函数 出错处理函数) 
  (defun catch-error (catch:Protected catch:OnError / catch:err) 
    (setq catch:err (vl-catch-all-apply catch:Protected)) 
    (if        (and (vl-catch-all-error-p catch:err) catch:OnError) 
      (Apply catch:OnError 
             (list (vl-catch-all-error-message catch:err)) 
      ) 
      catch:err 
    ) 
  ) 
  ;;2 默认的出错处理函数为 
  (defun DefaultOnError        (s)                          ;by Qiu Feng 
    (if 
      (not 
        (member        s 
                '("Function cancelled" "console break" "quit / exit abort") 
        ) 
      ) 
       (princ (strcat "\nError: " s)) 
    ) 
    (princ) 
  ) 
  ;;3 a为函数EW:Main中改变了的变量列表,如'("osmode" "orthomode"),返回(("osmode" 6311) ("orthomode" 0)) 
  (defun modes (a / MLST) 
    (repeat (length a) 
      (setq MLST (append MLST (list (list (car a) (getvar (car a)))))) 
      (setq a (cdr a)) 
    ) 
  ) 
  ;;4 根据变量列表，恢复变量 
  (defun moder (MLST) 
    (repeat (length MLST) 
      (setvar (caar MLST) (cadar MLST)) 
      (setq MLST (cdr MLST)) 
    ) 
  ) 
  ;;5 (setq ret (changevars '(("filedia" . 0)("cmdecho" . 0)("osmode" . 512)))) 
  ;;返回一个包含所有指定的系统变量和他们先前值的列表。要恢复他们，可简单地将该返回的列表提供给CHANGEVARS 函数 
  (defun changevars (lst / TMP VAR X) 
    (mapcar '(lambda (x / tmp var) 
               (setq tmp (cons (car x) 
                               (if (= (type (setq var (getvar (car x)))) 'list) 
                                 (list var) 
                                 var 
                               ) 
                         ) 
               ) 
               (setvar (car x) 
                       (if (= (type (cdr x)) 'list) 
                         (cadr x) 
                         (cdr x) 
                       ) 
               ) 
               tmp 
             ) 
            lst 
    ) 
  ) 
  ;;6 本程序主函数 
  (vl-load-com) 
  (setq *doc* (vlax-get-property (vlax-get-acad-object) 'activedocument)) 
  (setq old_cmd (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
  (setq SysVarList (modes EW:SysVarList)) 
  (vla-startundomark *doc*) 
  (setvar "cmdecho" old_cmd) 
  (if EW:OnError 
    (catch-error EW:Main EW:OnError) 
    (catch-error EW:Main 'DefaultOnError) 
  ) 
  (setvar "cmdecho" 0) 
  (vla-endundomark *doc*) 
  (moder SysVarList) 
  (setvar "cmdecho" old_cmd) 
  (princ) 
) 
;; ====================================================出错处理包装函数

wowan1314 · 发表于 2013-7-20 22:12:28

秋枫写的？！代码一多久头疼！

st788796 · 发表于 2013-7-20 22:32:39

wowan1314 发表于 2013-7-20 22:12
秋枫写的？！代码一多久头疼！

这个用法前面有过多个帖子用这种方法，现在更习惯简化的
[pcode=lisp,true]
(defun c:tt (/ oldos activedocument);_主程序的局部变量在 lambda 处定义
(setq oldos (getvar "osmode"));_后面程序中要用到的系统先行保存
(setq activedocument (vla-get-activedocument (vlax-get-acad-object)))
(vl-startundomark activedocument);_ Undo begin
(vl-catch-all-apply (function (lambda (/ ...) ....));_主程序部分，要设置的变量在内部根据需要设置,用 Funciton可以在 Lambda 内部设置断点方便调试
(vla-endundomark activedocument);_Undo end
(vlax-release-object activedocument)
(setvar "osmode" oldos);_恢复系统变量
(princ)
)[/pcode]

snsj · 发表于 2013-7-20 22:50:53

错误机制的处理也是LISP和C++和.NET程序相比的一个重要的缺陷，要是将ON ERROR GO的功能实现在LISP就好了

wowan1314 · 发表于 2013-7-20 23:10:22

snsj 发表于 2013-7-20 22:50
错误机制的处理也是LISP和C++和.NET程序相比的一个重要的缺陷，要是将ON ERROR GO的功能实现在LISP就好了

vl-catch-all-apply不是可以捕捉错误然后继续吗？！

snsj · 发表于 2013-7-20 23:42:12

本帖最后由 snsj 于 2013-7-20 23:55 编辑

当按ESC时，LISP会中断程序，C++和.NET可以跳转GO TO到程序的下个地方继续运行程序，可以把烂摊子收拾干净再走，比如用PLINE画一根线，当用户按取消退出程序时候想把这个线删了，LISP就需要重新定义错误函数去处理这个事情（错误函数写多了也容易乱），VBA或.NET只需要跳出来，把这个线删除了再退出程序。

evayleung · 发表于 2013-7-21 02:11:16

下载下来，慢慢研究，太多了，我的水平一下子看不懂。

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

[他山之石] Err_Routines

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

相关帖子

点评

点评

点评

点评

浏览过的版块