Fix old LISP+DCL

Hello all,

In an other topic i found this code:

But it returns an error when i run the command MESSAGE.

Error in dialog file
line 2: syntax error.
Symbol: "key".

I know nothing about DCL scripts and functions.

Could anyone take a look at it for me? :-)

Cheers!

;Tip1756a:  MESSAGE.LSP      Message Service            (c)2001, John R. Fair III;  $50 Bonus Winner

;;; ----------------------------------------------------------
;;;    Message.lsp is a program to store and retrieve        ;
;;; information about a drawing.  Use it to save notes to    ;
;;; yourself or others, information about "odd" non-standard ;
;;; things you were asked to do to a drawing.  Saves right in;
;;; the drawing, retrieve the message the next day, next week;
;;; or next year.
;;; ----------------------------------------------------------

;;; ************ main function *******************************

(defun
  C:MESSAGE (/ MSG-CMD MSG-DCL_ID)
 (setq
   OLDERR *ERROR*
   *ERROR* MERR
 ) ; end setq
 (if (< (setq MSG-DCL_ID (load_dialog "message.dcl")) 0)
; if dialog file is not loaded
   (exit) ; then exit
 ) ; end if
 (if (not (new_dialog "message" MSG-DCL_ID))
; if dialog box is not loaded
   (exit) ; then exit
 ) ; end if
 (SHOW_LIST "exmess")
 (action_tile "exmess" "(show_info $value)")
 (action_tile "delete" "(delmessage (get_tile \"exmess\"))")
 (action_tile "store" "(storemessage (get_tile \"newmess\"))")
 (action_tile
   "accept"
   "(yesno \"Message has not been stored!\" \"\" \"Do you wish to save the message?\" \"\")"
 ) ;_ end of action_tile
 (start_dialog)
 (princ)
) ; close defun

;;; ******************Store message function *******************

(defun
  STOREMESSAGE
  (MSG-MSG / MSG-MESSAGE MSG-XNAME MSG-SCRT MSG-XNAME MSG-AMPM)
 (setq
   MSG-MESSAGE 1
   MSG-SCRT
    (rtos (getvar "CDATE") 2 6)
 ) ; end setq
 (if (or (= MSG-MSG " ") (= MSG-MSG ""))
   (set_tile "error" "No Message to Store!")
   (progn
     (while (/= (dictsearch
; Use while loop to find last message in drawing
                  (namedobjdict)
                  (strcat "message" (rtos MSG-MESSAGE 2 0))
                ) ;_ end of dictsearch
                NIL
            ) ;_ end of /=
       (setq MSG-MESSAGE (1+ MSG-MESSAGE))
     ) ; end while
     (setq
       MSG-XNAME ; use entmakex to create the xrecord with no owner.
        (entmakex
          (append
            (list '(0 . "XRECORD") '(100 . "AcDbXrecord"))
            (list (cons 1 MSG-MSG))
            (list (cons 2 (getvar "LOGINNAME"))) ; Message stored by?
            (list
              (cons
                3
                (strcat
                  (substr MSG-SCRT 5 2) ; Date Message stored on?
                  "/"
                  (substr MSG-SCRT 7 2)
                  "/"
                  (substr MSG-SCRT 1 4)
                ) ; end strcat
              ) ; end cons
            ) ; end list
            (list
              (cons
                4
                (strcat ; Time Message stored at?
                  (if
                    (<=
                      (setq MSG-AMPM (fix (atof (substr MSG-SCRT 10 2))))
                      12
                    ) ;_ end of <=
                     (eval (substr MSG-SCRT 10 2))
                     (eval
                       (rtos
                         (- (fix (atof (substr MSG-SCRT 10 2))) 12)
                         2
                         0
                       ) ;_ end of RTOS
                     ) ;_ end of eval
                  ) ; end if
                  ":"
                  (substr MSG-SCRT 12 2)
                  " "
                  (if (>= MSG-AMPM 12) ; AM or PM ?
                    (eval "pm")
                    (eval "am")
                  ) ; end if
                ) ; end strcat
              ) ; end cons
            ) ; end list
          ) ; end append
        ) ; end entmakex
     ) ; end setq
     (dictadd
       (namedobjdict)
; add the new xrecord to the named object dictionary.
       (strcat "message" (rtos MSG-MESSAGE 2 0))
       MSG-XNAME
     ) ; end dictadd
     (set_tile "newmess" "")
     (set_tile "strdby" (getvar "loginname")) ; Show stored by name
     (set_tile
       "datestrd"
       (strcat
         (substr MSG-SCRT 5 2)
         "/"
         (substr MSG-SCRT 7 2)
         "/"
         (substr MSG-SCRT 1 4)
       ) ;_ end of strcat
     ) ; show date stored
     (set_tile
       "strdtm" ; show stored time
       (strcat
         (if
           (<= (setq MSG-AMPM (fix (atof (substr MSG-SCRT 10 2)))) 12)
; hours
            (eval (substr MSG-SCRT 10 2))
            (eval (rtos (- (fix (atof (substr MSG-SCRT 10 2))) 12) 2 0))
         ) ; end if
         ":"
         (substr MSG-SCRT 12 2) ; minutes
         " "
         (if (>= MSG-AMPM 12) ; am or pm
           (eval "pm")
           (eval "am")
         ) ; end if
       ) ; end strcat
     ) ; end set_tile
   ) ; close progn
 ) ; end if
 (SHOW_LIST "exmess") ; refresh message list
) ; close defun


;;; ****************** Function to delete messages ***********************

(defun
  DELMESSAGE (MSG-LINENO / MSG-TEST)
 (if (= MSG-LINENO "")
   (set_tile "error" "Please select a message to delete! ")
   (progn
     (setq MSG-TEST (read MSG-LINENO))
     (set_tile "error" "Deleting message, please wait....")
     (dictremove ; remove selected message from dictionary
       (namedobjdict)
       (strcat "message" (rtos (1+ (read MSG-LINENO)) 2 0))
     ) ;_ end of dictremove
     (while (dictrename ; rename any remaining message to fill gap
              (namedobjdict)
              (strcat "message" (rtos (+ MSG-TEST 2) 2 0))
              (strcat "message" (rtos (+ MSG-TEST 1) 2 0))
            ) ;_ end of dictrename
       (setq MSG-TEST (1+ MSG-TEST))
     ) ;_ end of while
   ) ;_ end of PROGN
 ) ;_ end of IF
 (set_tile "error" "") ; clear error and info tiles
 (set_tile "strdby" "")
 (set_tile "datestrd" "")
 (set_tile "strdtm" "")
 (SHOW_LIST "exmess") ; refresh  message list
) ;_ end of DEFUN

;;; *************** Error handler ****************************

(defun
  MERR (S)
 (if (not
       (member
         S
         '("console break" "Function canceled" "Invalid selection")
       ) ;_ end of member
     ) ; if command is aborted
   (princ (strcat "\nMessage Error: " S)) ; then prompt user
 ) ; end if
 (setq
   *ERROR* OLDERR
   MERR NIL
 ) ; undo back to mark
) ;_ end of defun

;;; *************** Show/Refresh message list *********************

(defun
  SHOW_LIST (MSG-TILE / MSG-ITEM MSG-MESSAGE)
 (start_list MSG-TILE) ; start message list
 (setq MSG-MESSAGE 1)
 (while (setq
          MSG-ITEM
           (dictsearch ; find any messages
             (namedobjdict)
             (strcat "message" (rtos MSG-MESSAGE 2 0))
           ) ;_ end of dictsearch
        ) ;_ end of setq
   (add_list (cdr (assoc 1 MSG-ITEM))) ; add message to list
   (setq MSG-MESSAGE (1+ MSG-MESSAGE))
 ) ;_ end of while
 (end_list) ; end list
) ;_ end of defun

;;; ****************** Show message info *************************

(defun
  SHOW_INFO (MSG-INFO / MSG-STRDBY MSG-DATESTRD MSG-RECORD)
 (setq
   MSG-RECORD
    (dictsearch ; find selected message in dictionary
      (namedobjdict)
      (strcat "message" (rtos (1+ (read MSG-INFO)) 2 0))
    ) ;_ end of dictsearch
 ) ;_ end of setq
 (if (cdr (assoc 2 MSG-RECORD)) ; display "Stored by:" info
   (set_tile "strdby" (cdr (assoc 2 MSG-RECORD)))
   (set_tile "strdby" "---")
 ) ;_ end of if
 (if (cdr (assoc 3 MSG-RECORD)) ; display "Date Stored:" info
   (set_tile "datestrd" (cdr (assoc 3 MSG-RECORD)))
   (set_tile "datestrd" "---")
 ) ;_ end of if
 (if (cdr (assoc 4 MSG-RECORD)) ; display "Time Stored" info
   (set_tile "strdtm" (cdr (assoc 4 MSG-RECORD)))
   (set_tile "strdtm" "---")
 ) ;_ end of if
) ;_ end of defun

;;; ************* Message alert box for unsaved messages ******************

(defun
  YESNO (MSG0 MSG1 MSG2 MSG3 /)
 (if (not (= (get_tile "newmess") ""))
; is there a message typed in new message box?
   (progn ; if yes show "do you want to save" alert
     (if (not (new_dialog "yes_no" MSG-DCL_ID))
; if dialog box is not loaded
       (exit) ; then exit
     ) ;_ end of if
     (set_tile "msg0" MSG0)
     (set_tile "msg1" MSG1)
     (set_tile "msg2" MSG2)
     (set_tile "msg3" MSG3)
     (action_tile "accept" "(done_dialog 1)")
; if yes then return to main dialog box
     (action_tile "cancel" "(term_dialog)")
; if no then terminate all dialog boxes
     (start_dialog)
   ) ;_ end of progn
   (done_dialog 1) ; if no message close dialog
 ) ;_ end of if
) ;_ end of defun

;;; ************** Message load alert function **************************

(if ; find selected message in dictionary
 (dictsearch (namedobjdict) "message1")
  (progn
    (if (< (setq MSG-DCL_ID (load_dialog "message.dcl")) 0)
; if dialog file is not loaded
      (exit) ; then exit
    ) ;_ end of if
    (if (not (new_dialog "yes_no" MSG-DCL_ID))
; if dialog box is not loaded
      (exit) ; then exit
    ) ;_ end of if
    (set_tile "msg0" "There are messages in this drawing!")
    (set_tile "msg1" "")
    (set_tile "msg2" "Do you want to view messages now?")
    (set_tile "msg3" "")
    (action_tile "accept" "(done_dialog 1)")
; if yes then return to main dialog box
    (action_tile "cancel" "(done_dialog 0)")
; if no then terminate all dialog boxes
    (if (= (start_dialog) 1)
      (C:MESSAGE)
    ) ;_ end of if
  ) ;_ end of progn
) ;_ end of if

(princ "\nType MESSAGE to start program")
(princ)

//;Tip1756b:  MESSAGE.DCL      Message Service            (c)2001, John R. Fair III;  $50 Bonus Winnermessage : dialog {	label = "Message Service" ;	//initial_focus = "exmess" ;	: boxed_column {		label = "Messages: " ;		: list_box {			//label = "Messages" ;			key = "exmess" ;			width = 80 ;			//height = 10 ;			value = "1" ;		}		: row {			: concatenation {				: text_part {					label = "Stored by: " ;				}				: text {					key = "strdby" ;					width = 10 ;				}				: text_part {					label = "Date Stored: " ;				}				: text {					key = "datestrd" ;					width = 10 ;				}				: text_part {					label = "Time Stored: " ;				}				: text {					key = "strdtm" ;					width = 10 ;				}			}			: button {				label = "Delete Message" ;				key = "delete" ;			}		}	}	: spacer { }	: row {		: edit_box {			label = "Message:" ;			key = "newmess" ;			width = 60 ;			edit_limit = 80;		}		: button {			label = "Store" ;			key = "store" ;		}	}	: button {		label = "OK" ;		key = "accept" ;		width = 15 ;		fixed_width = true;		alignment = centered;		is_default = true;	}	errtile ;}yes_no : dialog {    label = "Message Alert";    : column {	: text_part {         label = "";	 key = "msg0" ;	}	: text_part {         label = "";	 key = "msg1" ;	}	: text_part {         label = "";	 key = "msg2" ;	}	: text_part {         label = "";	 key = "msg3" ;	}    }    : row {      : spacer {}      : button {          label = " Yes ";          mnemonic = "Y";          key = "accept";          is_default=true;          fixed_width=true;          width=12;      }      : button {         label = " No  ";          mnemonic = "N";          key = "cancel";          is_cancel=true;          fixed_width=true;          width=12;      }      : spacer {}   }}

Judging by one post at the site from which you downloaded the routine the program ran in AutoCAD 2005 but failed to run in AutoCAD 2007 which leads me to believe the error may have to do with something AutoDesk either changed or subsequently dropped as regards commands used in lisp routines. Now here you are, twelve versions later, trying to resurrect the program.

The DCL part works fine (if you use the original formatting and not the one you posted here):

After uploading the .lsp file and the .dcl is somewhere in your thrusted paths you should get this error:

Command: MESSAGE
Message Error: quit / exit abort

caused by this line in the .lsp file:

(if (< (setq MSG-DCL_ID (load_dialog "message.dcl")) 0)
 ; if dialog file is not loaded
 (exit) ; then exit
) ; end if

So one solution is to rename the Tip1756b.dcl into message.dcl or use (load_dialog "Tip1756b.dcl").

Thanks Grrr,

The other download location worked like a charm.

Odd that the other website had a broken version...

Thanks again!