Topic: Universal Error Function

[GDF]

Can I modify (redine) AutoCAD's error function and add something to it, so that a cancel or escape will use my redefined error function?

I know I can modeify it within a lisp routine, I am looking for a universal error function for all of my routines.

Does this make sense?

Gary

[hudster]

Use the one on the afra lisp website and then call it from each routine, that's what I do.

http://www.afralisp.co.za/lispa/lisp6.htm

[T.Willey]

I think all you have to do is redefine the *error* function.  So if you have one that you want, and will work in all instances, the just do that in an mnl file or something that loads with every drawing.

[Kerry]

The *error* function should be LOCAL to the routine and declared as such ..

There are a lot of different ways to do it, here's one :

Code: [Select]

(defun c:Test (/ *error*)
  ;;
  ;; ----- set error trap ----------------------------------------
  (defun *error* (msg) (kb:on_error msg) (princ))
  (vla-endundomark kbg_activedoc)                     ;close open group
  (vla-startundomark kbg_activedoc)                   ;start new group
  (kb:savesysvar '(("CMDECHO" 0)
                     ("CLAYER")
                     ("BLIPMODE" 0)
                     ("OSMODE" 0)
                     ("ORTHOMODE" 0)
                     ("SNAPANG" 0.0)
                    )
  )
  ;; ----- initialise --------------------------------------------
  ;; ----- main body  --------------------------------------------
  (*error* nil)
  (princ)
)
with these :

Code: [Select]

;;;-----------------------------------------------------------------------------------
;;;----------------------------------------------------------------------------------- _
;;;       helper Library
;;;-----------------------------------------------------------------------------------
;;;----------------------------------------------------------------------------------- _
;;; change sysvar value and save its previous value

(defun kb:savesysvar (vars_list)
  (foreach item vars_list
    (setq kbg_sysvarlist (cons (list (car item) (getvar (car item))) kbg_sysvarlist))
    (if (cadr item)
      (setvar (car item) (cadr item))
    )
  )
)

;;;-----------------------------------------------------------------------------------
;;;-----------------------------------------------------------------------------------
(defun kb:on_error (msg / tmp)
  ;;----- Cancel any Active Commands -----------------------------
  (while (< 0 (getvar "cmdactive")) (command))
  (setvar "menuecho" 1)
  (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  ;;----- Display error message if applicable _-------------------
  (cond
    ((not msg))     ; no error, do nothing
    ((member (strcase msg t)     ; cancel
     '("console break" "function cancelled" "quit / exit abort")
     )
    )
    ((princ
       (strcat "\nApplication Error: " (itoa (getvar "errno")) " :- " msg)
     )
    )
  )
  (setvar "errno" 0)
  ;;----- Display backtrace if in debug mode ---------------------
  (if kbg_debug_on
    (vl-bt)
  )
  ;;----- Release Bound Activex Objects --------------------------
  (foreach varname kbg_objectsbound
    (if (= (type (setq tmp (vl-symbol-value varname))) 'vla-object)
      (if (not (vlax-object-released-p tmp))
(progn (vlax-release-object tmp) (set varname nil))
      )
    )
  )
  ;;----- Reset System Variables from global list ----------------
  (foreach item kbg_sysvarlist (setvar (car item) (cadr item)))
  (setq kbg_sysvarlist nil
kbg_objectsbound nil
  )
  (princ)
)
;;;-----------------------------------------------------------------------------------
;;;-----------------------------------------------------------------------------------

[GDF]

Thanks guys, I will play around with the tips over the weekend.

In vanilla AutoCAD where does the *cancel* come from when no lisp routine has been cancelled out?


Command: *Cancel*

Gary

[T.Willey]

Thanks guys, I will play around with the tips over the weekend.

In vanilla AutoCAD where does the *cancel* come from when no lisp routine has been cancelled out?


Command: *Cancel*

Gary

Most likely it is written in the code for the default error routine. </guess>

[GDF]

I think you are correct. However what I would like to do is have one universal error function for all routines that would override any existing error function,
like what one would do with the following ex: (setq S::Startup (append S::Startup ARCH::STARUP))

It would be neat if you could append, redefine or what ever and have the global-universar error function work for everthing. As part of this error funtion it would reset
all vars.

Here is what I use for each routine, error trapped within each routine.

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Undo Mark Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:UBEG  ()
  (setvar "CMDECHO" 0)
  (setq UNDO_BEGIN T)
  (command "UNDO" "BEGIN")
  (setvar "CMDECHO" 1)
  (princ))
(defun ARCH:UEND  ()
  (setvar "CMDECHO" 0)
  (setq UNDO_BEGIN ())
  (command "UNDO" "END")
  (setvar "CMDECHO" 1)
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Error Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:ERROR  (Msg)
  (setvar "cmdecho" 0)
  ;;(command "_ucs" "");dont use
  (setvar "cmdecho" 1)
  (if (and Msg (not (eq Msg "quit / exit abort")))
    ;;(princ Msg)
    (princ "\n\n*** ///////// Program  CANCELLED ///////// ***\n"))
  (ARCH:F_R-VAR)
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Error Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:ERROR  (Msg)
  (setvar "cmdecho" 0)
  ;;(command "_ucs" "");dont use
  (setvar "cmdecho" 1)
  (if (and Msg (not (eq Msg "quit / exit abort")))
    ;;(princ Msg)
    (princ "\n\n*** ///////// Program  CANCELLED ///////// ***\n"))
  (ARCH:F_R-VAR)
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Clean Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Juerg Menzi
;;;MENZI ENGINEERING GmbH, Switzerland
;;;http://www.menziengineering.ch
(defun ARCH:F_CLEAN  (Lst)
  (or Me:Aco (setq Me:Aco (vlax-get-acad-object)))
  (or Me:Acd (setq Me:Acd (vla-get-ActiveDocument Me:Aco)))
  (vla-StartUndoMark Me:Acd)
  (setq Me:Oer  *Error*
        *Error* ARCH:ERROR)
  (mapcar '(lambda (l)
             (if (not (assoc l Me:Var))
               (setq Me:Var (append Me:Var (list (cons l (getvar l)))))))
          Lst)
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; F_S-VAR Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:F_S-VAR  ()
  (ARCH:F_CLEAN
    '("APERTURE" "ATTDIA" "ATTREQ" "BLIPMODE" "CECOLOR" "CLAYER" "CELTYPE" "CMDECHO"
      "DIMSCALE" "DRAGMODE" "EXPERT" "FILEDIA" "FILLETRAD" "GRIDMODE" "HIGHLIGHT" "LUNITS"
      "MENUECHO" "MIRRTEXT" "OFFSETDIST" "ORTHOMODE" "OSMODE" "PICKBOX" "PLINEWID" "REGENMODE"
      "SNAPMODE" "SNAPUNIT" "SNAPBASE" "SNAPANG" "SNAPSTYL" "TEXTEVAL" "TEXTSTYLE")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; F_R-VAR Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Juerg Menzi
;;;MENZI ENGINEERING GmbH, Switzerland
;;;http://www.menziengineering.ch
(defun ARCH:F_R-VAR  ()
  (if Me:Var
    (mapcar '(lambda (l) (setvar (car l) (cdr l))) Me:Var))
  (setq *Error* Me:Oer
        Me:Oer  nil
        Me:Var  nil)
  (vla-EndUndoMark Me:Acd)
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;; Check Global Variables Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;10/13/99 Bill Zondlo
;;;use this program to clean up your custom autolisp programs.
;;;quickly finds user global variables/functions defined during use of custom programs,
;;;so you can add them to your local variables list without searching each line of program.
;;;It displays a list of new variables set during the drawing session.
;;;(setq ARCH#CHKV (atoms-family 1)) ;add to s::startup to make list
(defun ARCH:ChkGlobalVals  (/ ltr ltt)
;;;after custom program is run, run this program.
  (setq ltt (atoms-family 1))
;;;to get list of newly defined variables/functions.
  (princ (strcat "\nARCH#CHKV > "
                 (rtos (length ARCH#CHKV) 2 0)
                 " - ltt > "
                 (rtos (length ltt) 2 0))) ;prints length of each list.
  (foreach
         n  ltt ;compares each item in new list.
    (if (not (member n ARCH#CHKV))
    ;of newly defined variables/functions since start of drawing.     
      (setq ltr (append ltr (list n))) ;makes list of new items.
      ) ;end if
    (ARCH:WORKING)) ;end foreach
  (if (not (null ltr)) ;if new items.
    (progn (textscr) ;flips to text screen.
           (foreach m ltr (princ (strcat "\n " m))) ;prints new items to screen.
           ) ;end progn
    ) ;end if
  (princ)) ;end defun

Gary (in the dark)

[T.Willey]

The problem I see about trying to have one error function for all routines is you would have to name all your variables the same in all.  If you use objectdbx, or access to other programs that have to be release in certain ways, then that would be hard.  Maybe you can have one main one that would work with simple routines, and then one per more involved routines.

[GDF]

Thanks, I just realized that I don't know what I'm talking about, so I'll just keep things the way they are.

(the lights have been turned off)

[CADmium]

We also had discussed this theme... here ist the result

[GDF]

Thanks

Code: [Select]

We also had discussed this theme... here ist the result

But I don't speak anything but Texan

[CADmium]

But I don't speak anything but Texan

<dream> i know , that's german ( my english is also not so good). But the code is international, or not?
P.S: Google has also a translater

Thomas

[t-bear]

Thomas...your English is light-years ahead of my German. 
I like your sig..."In 99% of all problems, the comprehensive description of the problem is more than the half of the solution ." 

(Google translation, as you recommended).................

If I get the time today, I'll attempt a translation of the code.............wish me luck!

[t-bear]

here's what I came up with...it will need cleaning up.

Code: [Select]

Code:
    ;|
    Global Errorhandler
    Inklusive Undo-Funktion
    Inklusive Huckepack-Funktions Unterstützung
    - Beim Start
    - Bei Durchlauf ohne Fehler
    - Im Fehlerfall

    February 2004
    In collaboration with various CAD. DE Membern emerged

   More special thanks to at MAPCAR (http://www.autolisp.mapcar.net) for the        basis-Error-Handler and all the nice information on the nice Lisp-Interna :-).

    StartErrorHandler : Pile bar error correction routine arguments:
    NAME      = Freely more eligible String.
    If a (*error*)-Function issues something on the screen, it sets this name in addition so that one can recognize, what comes of which instance of the Errhandlers. 

    UNDOMODE     = T or Nil can be.
    Indicates whether in the mistake case and/or discontinuance case immediately the command is supposed to be
carried out 'UNDO', around all until there undertaken to make actions immediately annulled. 

    VARS_TO_SAVE = list of the system to be set and global variable

    ON-START     = Function that in the start carried out becomes (Nile for "do nothing carry out")
    ON-GOOD      = Function that in flawless conduit carried out becomes (Nil for "do nothing carry out")

    ON-BAD       = Function that in the mistake case carried out becomes (Nil for "do nothing carry out")

    ***********************************************************
    * Debugging /Activate back messages of the Errorhandlers: *
    * Setting of the GLOBAL variables (setq *VERBOSE* T)        *
    ***********************************************************

    Example 1: setting / Rücksetzen of Sysvars
    -------------------------------------------
    (defun C:TEST (/)
      (STARTERRORHANDLER
        "Function TEST"
        't
        '(("cmdecho" . 0) ("filedia" . 0))
        nil
        nil
        nil
      ) ;_ end of startErrorHandler
     
      (machwas)
     
      (ENDERRORHANDLER) ;_ NAME sets the variables out of the argument again back);_ of defun end

    Examples 2: use of user-defined of variable
    -----------------------------------------------------
    (defun C:LV-TEST (/)
      (STARTERRORHANDLER
        "LV-Test"
        't
        NIL
        '(lambda (/)
           (if (= INSTANCE 1)
             (SAVE-VARS '(MYVAR1 MYVAR2 MYVAR3) '*MYVARSTACK*)
           ) ;_ end of if
         ) ;_ end of lambda
        NIL
        '(lambda (/)
           (if (= INSTANCE 1)
             (RESTORE-VARS '*MYVARSTACK*)
           ) ;_ end of if
         ) ;_ end of lambda
      ) ;_ end of startErrorHandler
      (setq MYVAR1 4
            MYVAR2 5
            MYVAR3 6
      ) ;_ end of setq
      (getint "\nIrgendeine number input or ESC for discontinuance: ")
      (ENDERRORHANDLER)
    ) ;_ end of defun

    Examples 3: setting of the WKS / Rücksetzen of the BKS
    -----------------------------------------------------
    (defun C:WKSTEST (/)
      (STARTERRORHANDLER
        "WKSTest"
        't
        '(
          ("CMDECHO" . 0)
          ("CMDDIA" . 0)
          ("FILEDIA" . 0)
         )
        'SAVE-UCS                           ; on-start
        'RESTORE-UCS                        ; on-good
        NIL                                 ; Undo Also the BKS puts back! 
      ) ;_ end of startErrorHandler
      (getint "\input nIrgendeine number or ESC for discontinuance: ")
      (ENDERRORHANDLER)
    ) ;_ end of defun

    |;
    (defun STARTERRORHANDLER (NAME         UNDOMODE     VARSTOSAVE
                              ON-START     ON-GOOD      ON-BAD
                              /            ERRORTEMPLATE
                              SAVELIST     INSTANCE     O_CMDECHO
                             )
      (setq ERRORTEMPLATE
             '((MSG         /           NAME        UNDO        SAVEDVARS
                PREVIOUSHANDLER         INSTANCE    ON-START    ON-GOOD
                ON-BAD
               )
               ;;... Line yet is used  ;(setq instance <> )
               ;;... Line yet is used  ;(setq undo [T|nil])
               ;;... Line yet is used  ;(setq previoushandler <> )
               ;;... Line yet is used  ;(setq name <> )
               ;;... Line yet is used  ;(setq savedvars (quote ...
               ;;... Line yet is used  ;(setq on-start...
               ;;... Line yet is used  ;(setq on-good...
               ;;... Line yet is used  ;(setq on-bad...
               (while (> (getvar "cmdactive") 0) (command))
               (if
                (= INSTANCE 1)
                (progn
                 (command "_undo" "_end")
                 (if
                  (and UNDO MSG)
                  (command "_u")
                 )
                )
               )
               (foreach
                PAIR
                SAVEDVARS
                (setvar (car PAIR) (cdr PAIR))
                (if
                 (and MSG *VERBOSE*)
                 (progn
                  (princ
                   (strcat
                    "\n"
                    NAME
                    "("
                    (itoa INSTANCE)
                    "): Setze \""
                    (car PAIR)
                    "\" back up "
                   )
                  )
                  (princ (cdr PAIR))
                 )
                )
               )
               (if
                MSG
                (progn
                 (if
                  (and (= INSTANCE 1) *VERBOSE*)
                  (princ
                   (strcat "\nError:" NAME "(" (itoa INSTANCE) "): \"" MSG "\"")
                  )
                 )
                 (if
                  ON-BAD
                  ((eval ON-BAD))
                 )
                )
                (if
                 ON-GOOD
                 ((eval ON-GOOD))
                )
               )
               (setq *ERROR* PREVIOUSHANDLER)
               (if
                (= INSTANCE 1)
                (princ)
                (*ERROR* MSG)
               )
              )
      ) ;_ end of setq

      ;;*****************************************************

      (setq INSTANCE
             (if (or (= (type *ERROR*) 'SUBR) (null *ERROR*))
               1
               (1+ (caddr (cadr *ERROR*)))
             ) ;_ end of if
      ) ;_ end of setq
      (if (= INSTANCE 1)
        (progn
          (setq O_CMDECHO (getvar "cmdecho"))
          (setvar "cmdecho" 0)
          (command "_undo" "_begin")
          (setvar "cmdecho" O_CMDECHO)
        ) ;_ end of progn
      ) ;_ end of if
      (foreach PAIR VARSTOSAVE
        (setq SAVELIST
               (cons
                 (cons (car PAIR) (getvar (car PAIR)))
                 SAVELIST
               ) ;_ end of cons
        ) ;_ end of setq
        (setvar (car PAIR) (cdr PAIR))
      ) ;_ end of foreach
      (if ON-START
        ((eval ON-START))
      ) ;_ end of if
      (setq *ERROR*
             (append
               (list (car ERRORTEMPLATE))
               (list (list 'setq 'INSTANCE INSTANCE))
               (if UNDOMODE
                 '((setq UNDO 't))
                 '((setq UNDO NIL))
               ) ;_ end of if
               (list
                 (list 'setq
                       'PREVIOUSHANDLER
                       (cons 'quote (list *ERROR*))
                 ) ;_ end of list
               ) ;_ end of list
               (list (list 'setq 'NAME NAME))
               (list
                 (cons 'setq
                       (cons 'SAVEDVARS
                             (list (cons 'quote (list SAVELIST)))
                       ) ;_ end of cons
                 ) ;_ end of cons
               ) ;_ end of list
               (list (list 'setq 'ON-START ON-START))
               (list (list 'setq 'ON-GOOD ON-GOOD))
               (list (list 'setq 'ON-BAD ON-BAD))
               (cdr ERRORTEMPLATE)
             ) ;_ end of append
      ) ;_ end of setq
      (princ)
    ) ;_ end of defun

    ;|
    Put back global Errorhandler and restore Sysvars.

    More special thanks to at MAPCAR (http://www.autolisp.mapcar.net) for its Error-Handler
    endErrorHandler : Errorhandler put back and restore Sysvars
    Argument:
    No

    Example:
    Simply at the end of the routine

    (ENDERRORHANDLER)

   Call. 

    |;
    (defun ENDERRORHANDLER (/)
      (*ERROR* NIL)
    ) ;_ end of defun

    ;;; Sub-Functions For possible Huckepack-functions of the Errorhandler.

   ;;; Function determines whether the world coordinate system is current
   ;;; at present the proclamation.
   ;;; If not, is set it and T returned
   ;;; if yes the function gives Nil back

    (defun WORLD-UCS (/)
      (if (= (getvar "worlducs") 0)
        (progn (command "_.ucs" "_w") 't)
      ) ;_ end of if
    ) ;_ end of defun

    ;;; Function prior produces BKS again if UCSFLAG T is
    (defun PREVIOUS-UCS (/)
      (if UCSFLAG
        (command "_.ucs" "_p")
      ) ;_ end of if
    ) ;_ end of defun

    ;;; Grasps on the variable instance the
    ;;; Errorhandlers to - only in this call
    ;;; Environment! 
    (defun SAVE-UCS (/ UCSFLAG)
      (if (= INSTANCE 1)
        (progn
          (setq UCSFLAG (WORLD-UCS))
          (SAVE-VARS '(UCSFLAG) '*UCSDATA*)
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of defun


    ;;; Grasps on the variable instance the
    ;;; Errorhandlers to - only in this call
    ;;; Environment!
    (defun RESTORE-UCS (/ UCSFLAG)
      (if (= INSTANCE 1)
        (progn
          (RESTORE-VARS '*UCSDATA*)
          (PREVIOUS-UCS)
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of defun

    ;;; Puts an element on a pile off and gives it back
    ;;; necessarily for example for the restoring of user variable among others. 
    ;;;Arguments:
    ;;; ELM = name of the variables
    ;;; STACKSYM = name the stack
    (defun PUSH! (ELM STACKSYM /)
      (set STACKSYM (cons ELM (eval STACKSYM)))
      ELM
    ) ;_ end of defun


    ;;; Takes an element of a pile down and gives it back
    ;;; necessarily for example for the restoring of user variable among others. 
    ;;;Arguments:
    ;;; STACKSYM = name the stack
    (defun POP! (STACKSYM / ELM)
      (setq ELM (car (eval STACKSYM)))
      (set STACKSYM (cdr (eval STACKSYM)))
      ELM
    ) ;_ end of defun

    ;;; Sub-Function for the neutralizing of user variable on one stack
    ;;; arguments:
    ;;; VARS = list of variable name
    ;;; STACK = name the stack
    (defun SAVE-VARS (VARS STACK /)
      (foreach VAR VARS
        (PUSH! (cons VAR (eval VAR)) STACK)
      ) ;_ end of foreach
    ) ;_ end of defun

    ;;; Sub-Function for the restoring of user variable out of oneStack
    ;;; Argument:
    ;;; STACK = Name the Stacks
    (defun RESTORE-VARS (STACK / VAR)
      (repeat (length (eval STACK))
        (setq VAR (POP! STACK))
        (set (car VAR) (cdr VAR))
      ) ;_ end of repeat
    ) ;_ end of defun


.

------------------

[GDF]

Thanks Mr t-bear