[求助]对话框运行中，错误处理函数无法“UNDO”？

yunlong300

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

请教高手：在错误处理函数中如何判断当前运行的函数是在对话框模式还是命令行模式？
   如何解决对话框运行过程中出错，错误处理函数无法"undo"的问题？
|;
(defun c:test (/ AA DCL_ID FF ODCMD ODERR TEST:ERROR 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)
  )

  ;;对话框程序
  (defun test:dcl (TITLE MSG DEFAULT / AA DCL_ID  FF TMPFN VAL)
    (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))  ;;删除临时文件
    val
  );;defun
   

  ;;主程序
  (vl-load-com)
  (TEST:begin)
 
  (command "._line" '(0 0 0) '(100 100 0) "")  ;;画一条线，检查是否能够UNDO
  (vl-catch-all-apply 'test:dcl (list "test" "测试一下哈！" "123456"))
  (TEST:end)
  (princ "\n测试完毕！")
);;defun

ZZXXQQ

试了一下，ACAD完死了数回。在错误处理函数中加上DONE_DIALOG也不行。

yunlong300

顶起来，

不知道各位斑竹和高手们有什么好的解决办法?

龙龙仔

;;對話方塊執行期間不能使用COMMAND指令-------是規則

=>把程序結構改改即可!!

yunlong300

多谢龙斑竹指点~~

小弟回去再多翻翻书，仔细学习：）

龙龙仔

改好了記得貼上來(我改好了)

yunlong300

改了一下，测试通过。不知龙斑竹是如何改的：）

(defun c:test (/ DEFAULT ODCMD ODERR TEST:ERROR VAL TEST:error TEST:begin TEST:end test:dcl)
  ;;错误处理函数
  (defun TEST:error (msg )
    (if (/= msg "函数已取消")
      (princ (strcat "\n错误: " msg))
      (princ "\n*取消*")
    )
    (TEST:end)
    (command "._undo" "1")
    (princ)
  )

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

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

  ;;对话框程序
  (defun test:dcl (TITLE MSG DEFAULT / AA DCL_ID  FF TMPFN VAL Rcode)
    (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 0)")
        (action_tile "accept" "(setq val (get_tile \"input\"))
                               (done_dialog 1)"
        )
        (setq Rcode (start_dialog))
 (cond
          ;;(setq aa (/ 60 0))有错误，除数为0
   ((= Rcode 1) (setq aa (/ 60 0)))
 );;cond
        (unload_dialog dcl_id)
      );;progn
      (progn
        (princ "\n没有找到对话框文件!\n")
        (exit)
        (princ)
      );;progn
    );;if
    (if (findfile tmpfn) (vl-file-delete tmpfn))  ;;删除临时文件
    val
  );;defun
   

  ;;主程序
  (vl-load-com)
  (TEST:begin)
 
  (command "._line" '(0 0 0) '(100 100 0) "")  ;;画一条线，检查是否能够UNDO
  (test:dcl "test" "测试一下哈！" "123456")
  (TEST:end)
  (princ "\n测试完毕！")
);;defun

龙龙仔

跟你的差不多