[测试]：请教高手：对话框运行中，错误处理函数无法“UNDO”

yunlong3000

如何解决对话框运行过程中出错，错误处理函数无法"undo"的问题？
[PHP]
;|错误处理函数测试
在对话框状态下，如果出现错误，在程序调用错误处理函数时，遇到"undo"命令会出现CAD锁死现象！
以下是测试程序，运行前请保存好您的CAD文档，以免CAD锁死无法保存。

请教高手：在错误处理函数中如何判断当前运行的函数是在对话框模式还是命令行模式？
          如何解决对话框运行过程中出错，错误处理函数无法"undo"的问题？
|;
(defun c:test (/ AA DCL_ID DEFAULT FF MSG ODCMD ODERR TEST:ERROR TITLE TMPFN VAL TEST:begin TEST:end)
  ;;错误处理函数
  (defun TEST:error (msg)
    (if (/= msg "函数已取消")
      (princ (strcat "\n错误: " msg))
      (princ "\n*取消*")
    )
    ;;将以下两行屏蔽，CAD不会锁死，但是不能恢复函数运行前的状态。
    (TEST:end)
    (command "._undo" "1")
    (princ)
  )

  ;;初始化处理
  (defun TEST:begin ()           
    (setq odcmd (getvar "cmdecho"))
    (command "._undo" "_be")
    (setq oderr *error*)
    (setq *error* TEST:error)
    (princ)
  )

  ;;程序结束，恢复程序开始前的设置。
  (defun TEST:end ()
    (setvar "cmdecho" odcmd)
    (if oderr (setq *error* oderr))
    (command "._undo" "_e")
    (princ)
  )

  ;;主程序
  (vl-load-com)
  (TEST:begin)
  
  (command "._line" '(0 0 0) '(100 100 0) "")                ;;画一条线，检查是否能够UNDO
  (setq title    "test"
        msg      "测试一下哈！"
        default  "123456"
  )
  (setq tmpfn (vl-filename-mktemp "input.DCL"))        ;;生成临时文件
  ;;写临时文件的内容
  (setq FF (open tmpfn "w"))
  (write-line "input : dialog {" FF)
  (write-line "    label = \"标题\";" FF)
  (write-line "    key = \"title\";" FF)
  (write-line "    : text {" FF)
  (write-line "        label = \"123456\";" FF)
  (write-line "        key = \"message\";" FF)
  (write-line "    }" FF)
  (write-line "    : edit_box {" FF)
  (write-line "        key = \"input\";" FF)
  (write-line "        edit_width = 50;" FF)
  (write-line "    }" FF)
  (write-line "    ok_cancel_help;" FF)
  (write-line "}" FF)
  (close FF)

  ;;显示对话框
  (if (findfile tmpfn)
    (progn
      (setq dcl_id (load_dialog tmpfn))
      (if (not (new_dialog "input" dcl_id)) (done_dialog))
      (set_tile "title" title)
      (set_tile "message" msg)
      (set_tile "input" default)
      (mode_tile "input" 2)
      (action_tile "cancel" "(setq val default) (done_dialog)")
      ;;(setq aa (/ 60 0))有错误，除数为0
      (action_tile "accept" "(setq val (get_tile \"input\"))
                                   (setq aa (/ 60 0))               
                             (done_dialog)"
      )
      (start_dialog)
      (unload_dialog dcl_id)
    );;progn
    (progn
      (princ "\n没有找到对话框文件!\n")
      (exit)
      (princ)
    );;progn
  );;if
  (if (findfile tmpfn) (vl-file-delete tmpfn))  ;;删除临时文件
  (TEST:end)
  (princ "\n测试完毕！")
);;defun
[/PHP]

qxlonmsn

感谢老大的分享   又学到新东西