TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Amsterdammed on August 10, 2005, 05:49:00 PM
-
Hello everybody
Is there any way to tell lisp what to do on error, like in VBA?
Thanks in Advance
Bernd
-
Take a look HERE (http://www.theswamp.org/phpBB2/viewtopic.php?p=41436#41436)
-
Interesting
Got to understand this, I see.
Thanks, Ronjonp
-
; == For single modules:
(defun C:MyFunc ( / OldCmd *Error*)
(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 OldCmd (getvar "CMDECHO"))
(defun *Error* (Msg)
(setvar "CMDECHO" OldCmd)
(vla-EndUndoMark Me:Acd)
(if (and Msg (not (eq Msg "quit / exit abort")))
(princ Msg)
)
(princ)
)
;
;...code...
;
(*Error* nil)
)
; == For the common function library:
(defun C:MyFunc ( / )
(MeStartFunc '("CMDECHO" "OSMODE"))
;
;...code...
;
(MeEndFunc)
)
;
; -- Function MeStartFunc
; Start function to LISP programs.
; Arguments [Type]:
; Lst = Systemvars list [LIST]
; Return [Type]:
; > Null
; Notes:
; None
;
(defun MeStartFunc (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* MeUserError
)
(mapcar
'(lambda (l)
(if (not (assoc l Me:Var))
(setq Me:Var (append Me:Var (list (cons l (getvar l)))))
)
) Lst
)
(princ)
)
;
; -- Function MeEndFunc
; End function to LISP programs.
; Arguments [Type]:
; --- =
; Return [Type]:
; > Null
; Notes:
; None
;
(defun MeEndFunc ()
(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)
)
;
; -- Function MeUserError
; User error handler.
; Arguments [Type]:
; Msg = AutoLISP message [STR]
; Return [Type]:
; > Null
; Notes:
; None
;
(defun MeUserError (Msg)
(if (and Msg (not (eq Msg "quit / exit abort")))
(princ Msg)
)
(MeEndFunc)
(princ)
)
-
this is the error checking routine included on the old afralisp website.
just add (LOAD "ERROR.LSP") to your lisp routine and save the error.lsp in a pathed directory and away you go.
;;;
;;; TITLE: error.lsp
;;;
;;; Copyright (C) 2005 by www.afralisp.com
;;;
;;; Permission to use, copy, modify, and distribute this
;;; software and its documentation for any purpose and without
;;; fee is hereby granted
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR
;;; IMPLIED WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY
;;; PARTICULAR PURPOSE AND OF MERCHANTABILITY ARE HEREBY
;;; DISCLAIMED.
;;;
;;; www.afralisp.com
;;; April 2005
;;;
;;;-------------------------------------------------------------
;;; Description:
;;; Error trap, console break function to be called from
;;; within other lisp routines in event of error or user
;;; console break.
;;;
;;;-------------------------------------------------------------
;;; COMMAND LINE: none
;;;-------------------------------------------------------------
(defun error () ;load function
(prompt "\nGlobal Error Trap Loaded") ;inform user
(princ)
) ;defun
;;;*==========================================================
(defun initerr () ;init error
(setq oldlayer (getvar "clayer") ;save settings
osm (getvar "osmode")
oldpick (getvar "pickbox")
blip (getvar "blipmode")
tlm (getvar "tilemode")
cmd (getvar "cmdecho")
mnec (getvar "menuecho")
hilt (getvar "highlight")
)
(setq temperr *error*) ;save *error*
(setq *error* trap) ;reassign *error*
(princ)
) ;defun
;;;*===========================================================
(defun trap (errmsg) ;define trap
(command nil nil nil)
(if (not (member errmsg '("console break" "Function Cancelled"))
)
(princ (strcat "\nError: " errmsg)) ;print message
)
(command "undo" "b") ;undo back
(setvar "clayer" oldlayer) ;reset settings
(setvar "blipmode" blip)
(setvar "menuecho" mnec)
(setvar "highlight" hilt)
(setvar "osmode" osm)
(setvar "pickbox" oldpick)
(setvar "tilemode" tlm)
(princ "\nError Resetting Enviroment ") ;inform user
(terpri)
(setq *error* temperr) ;restore *error*
(princ)
) ;defun
;;;*===========================================================
(defun reset () ;define reset
(setq *error* temperr) ;restore *error*
(setvar "clayer" oldlayer) ;reset settings
(setvar "blipmode" blip)
(setvar "menuecho" mnec)
(setvar "highlight" hilt)
(setvar "osmode" osm)
(setvar "cmdecho" cmd)
(setvar "pickbox" oldpick)
(setvar "tilemode" tlm)
(princ)
) ;defun
;;;*======================================================
(princ)
-
:D
Thanks, Gentlemen