感谢分享,学习研究一下
谢谢楼主分享
本帖最后由 zml84 于 2023-2-1 19:57 编辑
凑个热闹
https://mp.weixin.qq.com/s/56eTQA4wHbpTKMgzelIBCQ
;;;========================================================*
;;;测试
(defun C:TT ()
(ZL-INPUTBOX
"身份验证"
'(("editbox" "用户名：" "USER" "20")
("editbox" "口 令：" "" "20")
("popup_list"
"类 型："
("受限用户""一般用户" "超级管理员")
"20"
)
;;
("spacer_1")
("text" "这是一个说明文本。")
("说明" "更多说明..." "说明信息1\n说明信息2\n...")
)
)
)
---------------------------------------------------------------------
;;;=================================================================*
;;; 定义通用数据输入窗体 *
;;; *
;;;=================================================================*
;|注意，调用参数均为字符串形式 *
;;;返回：字符串列表 *
;;;日期：zml84 于 2012-06-20
;;;-----------------------------------------------------------------*
;;;示例： *
(ZL-INPUTBOX *
"显示的对话框名称" *
'(("editbox" *
"editbox显示的说明" *
"editbox显示值" *
"20" *
) *
("popup_list" *
"popup_list显示的说明" *
("列表值1" "列表值2" "...") *
"20" *
) *
) *
) *
;;;=================================================================*
;;|;
(vl-load-com)
;;;=================================================================*
(defun ZL-INPUTBOX (STR_DIANAME LST /
LIST->DCLTEMPFILENAME F1
STR_JG I N DCLID
LST_RESULT str_sm key_sm
)
;;==================================================================*
;;功能：根据控件信息表，生成DCL语言的文本 *
;; 注意，调用参数均为字符串形式 *
;;示例：(list->dcl '( "editbox" "editbox显示的说明" "editbox显示值""20") 100)
;;(list->dcl '( "popup_list" "popup_list显示的说明" ("列表值1" "列表值2" "...")"20") 101)
;;(list->dcl '( "popup_list" "popup_list显示的说明" "列表值1\\n列表值2\\n...""20") 102)
;;返回：与控件对应的dcl文本
;;日期：zml84 于 2012-06-20
(defun LIST->DCL (LST KEY_I / X)
(cond
;;
((wcmatch (car LST) "ZML84*")
(strcat
":button{"
(strcat "\nlabel=\""
(nth 0 LST)
"\";"
"\nis_enabled = false;"
)
"\n}\n"
)
)
;;标准按钮，点击后显示更多说明信息。
;;格式：("说明"按钮名称 信息)
;;示例：("说明" "更多说明..." "说明信息1\n说明信息2\n...")
((wcmatch (car LST) "说明")
(setq str_sm (nth 2 lst));_设置说明文本，供后面回调用
(strcat
":button{"
(strcat "\nlabel=\""
(nth 1 LST)
"\";"
(strcat "\nkey =\"KEY_SM\";")
"\nis_enabled = true;"
)
"\n}\n"
)
)
;;
((= (car LST) "editbox")
(strcat
":edit_box{"
"\nallow_accept = true ;"
(strcat "\nedit_width ="
(nth 3 LST)
";"
)
"\nfixed_width = true ;"
(strcat "\nkey =\"" (itoa KEY_I) "\";")
(strcat "\nlabel=\""
(nth 1 LST)
"\";"
)
(strcat "\nvalue=\""
(nth 2 LST)
"\";"
)
"\n}\n"
)
)
;;
((= (car LST) "popup_list")
(strcat
":popup_list{"
(strcat "\nwidth ="
(nth 3 LST)
";"
)
(strcat "\nlabel=\""
(nth 1 LST)
"\";"
)
(strcat "\nkey =\"" (itoa KEY_I) "\";")
(cond
((= (type (nth 2 LST)) 'STR)
(strcat "\nlist=\""
(nth 2 LST)
"\";"
)
)
((= (type (nth 2 LST)) 'list)
(strcat
"\nlist=\""
(apply
'strcat
(mapcar
'(lambda (X)
(strcat "\\n"
(vl-princ-to-string X)
)
)
(nth 2 LST)
)
)
"\";"
)
)
) ;_结束 cond
"\n}\n"
)
)
;;
((= (car LST) "text")
(strcat
":text{"
(strcat "\nlabel=\""
(nth 1 LST)
"\";"
)
"\n}\n"
)
)
;;
((= (car LST) "spacer_1")
(strcat"\n"
(nth 0 LST)
";\n"
)
)
;;; ((/= (LIST->DCL (cons "editbox" LST) KEY_I) "")
;;; (LIST->DCL (cons "editbox" LST) KEY_I)
;;; )
(t "")
) ;_结束 cond
) ;_结束defun
;;==================================================================*
;;功能：定义按下确定按钮后的操作
(defun GETINPUT (LEN / I N TMP)
(setq RESULTLIST '()
I 0
)
(repeat(length LST)
(setq N (nth I LST))
(cond
;;
((= (car N) "editbox")
(setq LST_RESULT
(cons (get_tile (itoa I)) LST_RESULT)
)
)
;;
((= (car N) "popup_list")
(setq TMP (nth 2 N))
;;tmp有两种格式：字符形式的 和 表形式
;;如果是字符格式的，就转换为表（以\n分割）
(cond
((= (type (nth 2 N)) 'STR)
(setq TMP "*INPUTBOX函数 有待完善*")
)
((= (type (nth 2 N)) 'list)
(setq TMP (nth (atoi (get_tile (itoa I))) TMP))
)
)
(setq LST_RESULT
(cons TMP LST_RESULT)
)
)
;;
;;
(t
(setq LST_RESULT
(cons NIL LST_RESULT)
)
)
)
(setq I (1+ I))
)
(setq LST_RESULT (reverse LST_RESULT))
) ;_结束defun
;;==================================================================*
(setq TEMPFILENAME (vl-filename-mktemp "dcltmp.dcl"))
(setq F1 (open TEMPFILENAME "w"))
;;组织头部
(setq STR_JG (strcat
"InputBox:dialog {"
(strcat "\nlabel =\"" STR_DIANAME "\";")
)
)
;;组织正文
(setq I 0)
(repeat (length LST)
(setq N (nth I LST))
(setq STR_JG (strcat STR_JG
(LIST->DCL N I)
)
)
(setq I (1+ I))
)
;;组织按钮、
(setq STR_JG
(strcat
STR_JG
"\nspacer_0;"
"\nok_cancel;"
;;zml个人信息
"\n:button{"
"\nlabel=\"ZML84作品，必属精品。\";"
"\nis_enabled = false;\n}\n"
;;
;;; "\n:text{"
;;; "\nlabel=\"ZML84作品，必属精品。\";"
;;; "\nis_enabled = false;"
;;; "\n}\n"
;;对话框结束
"\n}\n"
)
)
;;写入文件
(princ STR_JG F1)
;;关闭文件
(close F1)
(setq DCLID (load_dialog TEMPFILENAME))
(if(not (new_dialog "InputBox" DCLID ""))
(progn (alert "对话框加载失败!") (exit))
)
(action_tile
"accept"
"(GetInputLst ) (done_dialog 1)"
)
(if STR_SM
(action_tile
"KEY_SM"
"(if zl-msgbox (ZL-msgbox nil \"i\" STR_SM 0)(ALERT STR_SM))"
))
(start_dialog)
(unload_dialog DCLID)
(vl-file-delete TEMPFILENAME)
;;返回
LST_RESULT
)
谢谢分享。
zml84 发表于 2023-2-1 19:53
凑个热闹
https://mp.weixin.qq.com/s/56eTQA4wHbpTKMgzelIBCQ
多年前就在你的博客上掏了不少干货，包含这个。。。。
wzg356 发表于 2023-2-2 13:19
多年前就在你的博客上掏了不少干货，包含这个。。。。
相互学习，共同进步！
能给个完整的示例吗？大佬
本帖最后由 wzg356 于 2023-2-10 12:55 编辑
20230209更，输入框数据检查改为实时现场纠错，免币源码在http://bbs.mjtd.com/forum.php?mo ... =1&extra=#pid908231“通用函数-坐标处理.lsp”里面，那个帖子的所有程序都直接用的这个通用输入框
20230213更，增加为5种控件，改进应用体验，还可与图面交互
wzg356 发表于 2023-2-13 22:08
20230213更，增加为5种控件，改进应用体验，还可与图面交互
谢谢大佬分享