Avaliação de Erros

As rotinas abaixo, servem para dar um toque mais profissional nas rotinas, assim como o acet-error-init do Express Tools, elas controlam o que acontece com a rotina em caso de erro. Isso evita que tenhamos Undos e Redos desnecessários, fazendo a rotina se comportar como um comando do cad.
Elas devem ser usadas assim:

(defun c:sualisp (/
; sempre aperece no início 
  (tbn:error-init
    (list (list "cmdecho" 0 )
;| após a execução, 
   restaure estas variaveis
   em caso de erro, execute isto... |;

    '(func_de_erro
)) 


;| a sua rotina normal... 
aqui você coloca seus codigos 
se tudo correr bem até aqui termina com |;


(tbn:error-restore)
)



A seguir as rotinas de prevenção de erros:

(defun tbn:error-init (sys / tmp ss cmd)
  (
defun-q-list-set 'tbn:error_exe (list nil (cadr sys)))
  (
setq tbn:olderr     *error*
    *error*
        (lambda (s)
             (
setq yy s)
             (
if (/= s "Function cancelled")
               (
prompt (strcat "\nError: " s)))
             (
if (/= (getvar "cmdnames") "")
               (
command))
             (
tbn:error_exe)
             (
tbn:error-restore))
        sys            (car sys)
    tbn:sysvars    nil
        tbn:error-undo (getvar "undoctl")
        ss             (ssgetfirst)
    cmd           (getvar "cmdecho"))

  (
setvar "cmdecho" 0)
  (
cond ((= 2 (logand tbn:error-undo 2))
     (
command "_.undo" "_control" "_all"
          "_.undo" "_auto" "_off"
))
    ((
/= 1 (logand tbn:error-undo 1))
     (
command "_.undo" "_all"
          "_.undo" "_auto" "_off"
)))
  (
command "_.UNDO" "_group")
  (
setvar "cmdecho" cmd)
  
  (
repeat (/ (length sys) 2)
    (
setq tmp         (car sys)
          tbn:sysvars (cons (list tmp (getvar tmp))
                tbn:sysvars)
          tmp         (setvar tmp (cadr sys))
          sys         (cddr sys)))
  (
sssetfirst (car ss) (cadr ss)))


(
defun tbn:error-restore (/ cmd)
  (
setq *error* tbn:olderr)
  (
foreach x tbn:sysvars (setvar (car x) (cadr x)))
  (
redraw)
  (
setq cmd (getvar "cmdecho"))
  (
setvar "cmdecho" 0)
  (
command "_.UNDO" "_e")
  (
cond ((/= 1 (logand tbn:error-undo 1))
     (
command "_.undo" "_control" "_none"))
        ((
= 2 (logand tbn:error-undo 2))
     (
command "_.undo" "_control" "_one")))
  (
setvar "cmdecho" cmd)
  (
princ))

Nenhum comentário:

Postar um comentário