guangdonglbq 发表于 2008-4-19 09:12:00

标准化输入对话框lisp代码

;;;标准输入对话框 <br/>;;;调用形式 (InputBox 显示的对话框名称 表( ( "editbox显示的说明" "editbox显示值" "editbox显示宽度") ...) ) <br/>;;;注意，调用参数均为字符串形式 <br/>;;;返回值为与输入表长度相等的字符串列表 <br/>;;;注意：以下代码未对输入代码格式进行检查，有需要时，需人加入格式检查的代码 <br/>(defun InputBox (strDialogName EditBoxDefList <br/>/ ResultList fStream dclname tempFileName fileN fileStream templist i <br/>dclid) <br/>;;;------------------------------------------------- <br/>(defun GetInput (len) <br/>(setq i 1 <br/>ResultList nil <br/>) <br/><br/>(repeat len <br/>(setq ResultList <br/>(append ResultList (list (get_tile (itoa i)))) <br/>) <br/><br/>(setq i (1+ i)) <br/>) <br/>) <br/>;;;------------------------------------------------- <br/>(setq tempFileName (vl-filename-mktemp "dcltmp.dcl")) <br/>(setq fileN (open tempFileName "w")) <br/><br/>(setq fileStream (list <br/>"InputBox:dialog {\n" <br/>(strcat "label =\"" strDialogName "\";\n") <br/>) <br/>) <br/>(setq i 0) <br/>(repeat (length EditBoxDefList) <br/>(setq templist (nth i EditBoxDefList)) <br/>(setq fileStream (append fileStream <br/>(list <br/>":edit_box{\n" <br/>"allow_accept = true ;\n" <br/>(strcat "edit_width =" (caddr templist) ";\n") <br/>"fixed_width = true ;\n" <br/>(strcat "key =\"" (itoa (1+ i)) "\";\n") <br/>(strcat "label=\"" (car templist) "\";\n") <br/>(strcat "value=\"" (cadr templist) "\";\n") <br/>) <br/>) <br/>) <br/><br/>(setq i (1+ i)) <br/>) <br/><br/>(setq fileStream (append fileStream <br/>(list <br/><br/>"} ok_cancel;\n" <br/>"}\n" <br/>) <br/>) <br/>) <br/>(foreach fStream <br/>fileStream <br/>(princ fStream fileN) <br/>) <br/>(close fileN) <br/><br/>(setq dclname tempFileName) <br/><br/><br/>(setq dclid (load_dialog dclname)) <br/>(if (not (new_dialog "InputBox" dclid "")) <br/>(progn (alert "对话框加载失败!") (exit)) <br/>) <br/><br/>(action_tile "accept" "(GetInput (length EditBoxDefList) ) (done_dialog 1)" ) <br/><br/>(start_dialog) <br/><br/>(unload_dialog dclid) <br/>(vl-file-delete dclname) <br/><br/>ResultList <br/>) <br/>;;;-------------------------------------------------

Michael527 发表于 2008-5-8 21:47:00

试试楼主的函数，谢谢分享！

paulpipi 发表于 2020-2-6 10:58:33

试试楼主的函数，谢谢分享！

yjtdkj 发表于 2020-11-9 09:54:12

我试了一下，表里只有一项时是可以的，但表中有两项就出错了

yjtdkj 发表于 2020-11-9 10:28:36

查到原因了，是少了一个括号
;;;标准输入对话框
;;;调用形式 (InputBox 显示的对话框名称 '( ( "editbox显示的说明" "editbox显示值" "editbox显示宽度") ...) )
;;;注意，调用参数均为字符串形式
;;;返回值为与输入表长度相等的字符串列表
;;;注意：以下代码未对输入代码格式进行检查，有需要时，需人加入格式检查的代码
(defun InputBox(strDialogName EditBoxDefList
   /         ResultList    fStream
   dclname       tempFileNamefileN
   fileStream    templist       i
   dclid n
    )
;;;-------------------------------------------------
(defun GetInput (len / i)
    (setq i 1
    ResultList
   nil
    )

    (repeat len
      (setq ResultList
       (append ResultList (list (get_tile (itoa i))))
      )

      (setq i (1+ i))
    )
)
;;;-------------------------------------------------
(setq tempFileName (vl-filename-mktemp "dcltmp.dcl"))
(setq fileN (open tempFileName "w"))

(setqfileStream
   (list
   "InputBox:dialog {\n"
   (strcat "label =\"" strDialogName "\";\n")
   )
)
(setq i 0)
(repeat (length EditBoxDefList)
    (setq templist (nth i EditBoxDefList))
    (setq fileStream
   (append fileStream
       (list
         ":edit_box{\n"
         "allow_accept = true ;\n"
         (strcat "edit_width =" (caddr templist) ";\n")
         "fixed_width = true ;\n"
         (strcat "key =\"" (itoa (1+ i)) "\";\n")
         (strcat "label=\"" (car templist) "\";\n")
         (strcat "value=\"" (cadr templist) "\";\n")
         "}"
       )
   )
    )

    (setq i (1+ i))
)

(setqfileStream
   (append fileStream
   (list

       "ok_cancel;\n"
       "}\n"
   )
   )
)
(foreach n
       fileStream
    (princ n fileN)
)
(close fileN)

(setq dclname tempFileName)


(setq dclid (load_dialog dclname))
(if (not (new_dialog "InputBox" dclid ""))
    (progn (alert "对话框加载失败!") (exit))
)

(action_tile
    "accept"
    "(GetInput (length EditBoxDefList) ) (done_dialog 1)"
)

(start_dialog)

(unload_dialog dclid)
(vl-file-delete dclname)

ResultList
)
;;;-------------------------------------------------

页: [1]
查看完整版本: 标准化输入对话框lisp代码