通用多层面板
好久没发帖了，最近学习dcl，用之前明经下的一个通用面板程序练了下手，增加了多行多列的表格格式支持，加了一个单独的控制按钮，欢迎交流。我这边有个问题，主程序定义了局部函数 titl，主面板子程序使用主程序的局部函数 titl，其他子面板子程序定义了专用的子程序的局部函数 titl，然后在使用的时候就发现一个问题，从子面板返回主面板时，主程序的 titl 被子程序的 titl 覆盖了，局部函数不是随着程序的子程序的结束而释放吗？;;示例qq
(defun c:qq ( / titl titl0 msg lst switch
main more-1 more-2
more-3 more-4 more-5 )
;通用定义
(setq titl0 "xx工具箱 v20141203")
(setq msg
(strcat
"\nmade by lostbalance"
)
)
(setq switch "main 主页面(&Z)")
;;================================
(defun main()
(setq *panel-num* 0)
(setq lst
'(
(
("命令组1"
(
"FUNC1 命令1"
"FUNC2 命令2"
"FUNC3 命令3"
"more-1 =汇总= (&W)"
)
)
("命令组2"
(
"FUNC4 命令4"
"FUNC5 命令5"
"FUNC6 命令6"
"more-2 =汇总= (&E)"
)
)
("命令组3"
(
"FUNC7 命令7"
"FUNC8 命令8"
"FUNC9 命令9"
"more-3 =汇总= (&R)"
)
)
)
(
("命令组4"
(
"FUNC10 命令10"
"FUNC11 命令11"
"FUNC12 命令12"
"more-4 =汇总= (&S)"
)
)
("命令组5"
(
"FUNC13 命令13"
"FUNC14 命令14"
"FUNC15 命令15"
"more-5 =汇总= (&D)"
)
)
)
)
)
(WYB-panel titl0 msg lst switch nil nil)
)
(defun more-1 (/ titl lst)
(setq *panel-num* 1)
(setq titl "命令组1")
(setq lst
'(
(
(""
(
"FUNC1 命令1 (&S)"
"FUNC2 命令2 (&D)"
"FUNC3 命令3 (&F)"
)
)
(""
(
"FUNCA1 命令A1 (&W)"
"FUNCA2 命令A2 (&E)"
)
)
)
)
)
(WYB-panel titl msg lst switch 20 nil)
)
(defun more-2 (/ titl lst)
(setq *panel-num* 2)
(setq titl "命令组2")
(setq lst
'(
(
(""
(
"FUNC4 命令4 (&S)"
"FUNC5 命令5 (&D)"
"FUNC6 命令6 (&F)"
)
)
(""
(
"FUNCB1 命令B1 (&W)"
"FUNCB2 命令B2 (&E)"
"FUNCB3 命令B3 (&R)"
)
)
)
)
)
(WYB-panel titl msg lst switch 20 nil)
)
(defun more-3 (/ titl lst)
(setq *panel-num* 3)
(setq titl "命令组3")
(setq lst
'(
(
(""
(
"FUNC7 命令7 (&S)"
"FUNC8 命令8 (&D)"
"FUNC9 命令9 (&F)"
)
)
(""
(
"~FUNCC1 命令C1 (&W)"
"~FUNCC2 命令C2 (&E)"
"~FUNCC3 命令C3 (&R)"
)
)
)
)
)
(WYB-panel titl msg lst switch 20 nil)
)
(defun more-4 (/ titl lst)
(setq *panel-num* 4)
(setq titl "命令组4")
(setq lst
'(
(
(""
(
"FUNC10 命令10 (&S)"
"FUNC11 命令11 (&D)"
"FUNC12 命令12 (&F)"
)
)
(""
(
"~FUNCD1 命令D1 (&W)"
"~FUNCD2 命令D2 (&E)"
"~FUNCD3 命令D3 (&R)"
)
)
)
)
)
(WYB-panel titl msg lst switch 20 nil)
)
(defun more-5 (/ titl lst)
(setq *panel-num* 5)
(setq titl "命令组5")
(setq lst
'(
(
(""
(
"FUNC13 命令13 (&S)"
"FUNC14 命令14 (&D)"
"FUNC15 命令15 (&F)"
)
)
(""
(
"FUNCE1 命令E1 (&W)"
"FUNCE2 命令E2 (&E)"
"FUNCE3 命令E3 (&R)"
)
)
)
)
)
(WYB-panel titl msg lst switch 20 nil)
)
(cond
((= *panel-num* 1)(more-1))
((= *panel-num* 2)(more-2))
((= *panel-num* 3)(more-3))
((= *panel-num* 4)(more-4))
((= *panel-num* 5)(more-5))
((main))
)
(princ)
)
;;==========================================
;;5.3 多层面板
;;(WYB-panel titl msg lst switch bwidth flag)
;;titl: 标题
;;msg: 帮助提示
;;buttons:按钮列表(命令前加"~"，按钮变灰|名称后面加"(&字母)"，设置面板按钮的快捷键)
;;switch: 下按钮(str，"快捷键 命令名")，nil取消
;;Bwidth: 按钮的宽度，nil为自动调整
;;flag: nil 先行后列|T 先列后行
;;==========================================
;;v1.0 by llsheng-73 edata
;;v1.1 by lostbalance 20141203
;;==========================================
(defun WYB-panel ( titl msg buttons switch Bwidth flag
/ strsplist makedcl dclfile lst-s lst-t cmdlst
dcl-str Bwidth-str cmd-n dcl act act-lst i ctl cmd
)
(defun strsplist (str / i)
(if (setq i (vl-string-search " " str))
(list (substr str 1 i) (vl-string-trim " " (substr str (+ 2 i))))
)
)
(defun makedcl (lst / fileid dclhandle)
(setq dclfile (vl-filename-mktemp nil nil ".dcl")
fileid(open dclfile "w")
)
(cond
((= (type lst) 'str) (write-line lst fileid))
((= (type lst) 'list) (foreach n lst (write-line n fileid)))
)
(close fileid)
(setq dclhandle (load_dialog dclfile))
)
(if Bwidth (setq Bwidth-str (strcat "fixed_width = true; width = " (rtos Bwidth) "; "))(setq Bwidth-str ""))
(if flag
(setq
lst-s "\n:column{ label = \""
lst-t "\n:row{ children_alignment = top; children_fixed_height = true; label = \""
)
(setq
lst-s "\n:row{ children_alignment = top; children_fixed_height = true; label = \""
lst-t "\n:column{label = \""
)
)
(setq
cmdlst '("esc")
dcl-str (strcat (vl-string-translate "$~" "ab" (vl-filename-base (vl-filename-mktemp)))
":dialog{label=\"" titl "\";"
)
)
(foreach xxx buttons
(if (listp xxx);列集合
(progn
(setq dcl-str (strcat dcl-str "\nspacer_1;" lst-s "\";"))
(foreach xx xxx
(if (listp xx);命令列
(progn
(setq dcl-str (strcat dcl-str lst-t (car xx) "\";"))
(foreach x (last xx)
(setq
cmd-n (strsplist x)
dcl-str (if cmd-n
(strcat dcl-str "\n:button{ " Bwidth-str
"key =\"" (car cmd-n) "\"; label=\"" (last cmd-n) "\"; "
(if (= (substr (car cmd-n) 1 1) "~") "is_enabled = false; " "")
"}"
)
(strcat dcl-str "\nspacer_0;")
)
cmdlst (if (/= (car cmd-n) nil) (cons (car cmd-n) cmdlst) cmdlst)
)
)
(setq dcl-str (strcat dcl-str "}"))
)
(setq dcl-str (strcat dcl-str "\nspacer_0;"))
)
)
(setq dcl-str (strcat dcl-str "}"))
)
)
)
(setq cmdlst (cdr (reverse cmdlst))
dcl-str (strcat dcl-str "\nspacer_1;\n:row{ alignment = centered; fixed_width = true; \nspacer_0;")
)
(if (and switch (setq cmd-n (strsplist switch)))
(setq
dcl-str (strcat dcl-str
"\n:button{ fixed_width = true; width = 4; key = \"" (car cmd-n) "\"; label = \"" (last cmd-n) "\";}")
cmdlst (if (/= (car cmd-n) nil) (cons (car cmd-n) cmdlst) cmdlst)
)
)
(if msg
(setq dcl-str (strcat dcl-str "\n:button{ fixed_width = true; width = 4; key = \"help\"; label = \" 帮助 \";}"))
)
(setq
dcl-str (strcat dcl-str
"\n:button{ fixed_width = true; width = 4; key=\"cancel\"; label=\" 关闭 \"; is_cancel = true;is_default = true;}}}")
dcl (makedcl dcl-str)
act-lst '()
i 1
)
(foreach key cmdlst
(setq act (strcat "(action_tile \"" key "\"\"(done_dialog " (itoa i) ")\")")
act-lst (cons act act-lst)
i (1+ i)
)
)
(new_dialog (substr dcl-str 1 8) dcl)
(action_tile "cancel" "(done_dialog 0)")
(if msg (action_tile "help" "(alert msg)"))
(eval (read (strcat "(progn" (apply 'strcat act-lst) ")")))
(setq ctl (start_dialog))
(unload_dialog dcl)
(vl-file-delete dclfile)
(if (/= ctl 0)
(progn
(setq cmd (nth (- ctl 1) cmdlst))
;;检查命令是否~开头,有就去掉,如果运行中没有更改该命令button的enable值,这句可以不要
(if (= (substr cmd 1 1) "~") (setq cmd (substr cmd 2 (1- (strlen cmd)))))
(cond ;新的命令判断方式,代码更短
((boundp (read (strcat "c:" cmd)))(princ "\n")(eval (read (strcat "(c:" cmd ")"))))
((boundp (read cmd))(princ "\n")(eval (read (strcat "(" cmd ")"))))
(t (princ "\n")(vl-cmdf cmd))
)
)
)
)
本帖最后由 fangmin723 于 2021-5-17 15:34 编辑
我做的面板
(list
(list
(list '("1bt01" "1bt01") '("1bt02" "1bt02") '("1bt03" "1bt03") '("1bt04" "1bt04"))
(list '("1bt11" "1bt11") '("1bt12" "1bt12") '("1bt13" "1bt13") '("1bt14" "1bt14"))
(list '("1bt21" "1bt21") '("1bt22" "1bt22") '("1bt23" "1bt23") '("1bt24" "1bt24"))
(list '("1bt31" "1bt31") '("1bt32" "1bt32") '("1bt33" "1bt33") '("1bt34" "1bt34"))
(list '("1bt41" "1bt41") '("1bt42" "1bt42") '("1bt43" "1bt43") '("1bt44" "1bt44"))
(list '("1bt51" "1bt51") '("1bt52" "1bt52") '("1bt53" "1bt53") '("1bt54" "1bt54"))
(list '("1bt61" "1bt61") '("1bt62" "1bt62") '("1bt63" "1bt63") '("1bt64" "1bt64"))
(list '("1bt71" "1bt71") '("1bt72" "1bt72") '("1bt73" "1bt73") '("1bt74" "1bt74"))
(list '("1bt81" "1bt81") '("1bt82" "1bt82") '("1bt83" "1bt83") '("1bt84" "1bt84"))
(list '("1bt91" "1bt91") '("1bt92" "1bt92") '("1bt93" "1bt93") '("" "")) ;'("1bt94" "1bt94")
)
(list
(list '("2bt01" "2bt01") '("2bt02" "2bt02") '("2bt03" "2bt03") '("2bt04" "2bt04"))
(list '("2bt11" "2bt11") '("2bt12" "2bt12") '("2bt13" "2bt13") '("2bt14" "2bt14"))
(list '("2bt21" "2bt21") '("2bt22" "2bt22") '("2bt23" "2bt23") '("2bt24" "2bt24"))
(list '("2bt31" "2bt31") '("2bt32" "2bt32") '("2bt33" "2bt33") '("2bt34" "2bt34"))
(list '("2bt41" "2bt41") '("2bt42" "2bt42") '("2bt43" "2bt43") '("2bt44" "2bt44"))
(list '("2bt51" "2bt51") '("2bt52" "2bt52") '("2bt53" "2bt53") '("2bt54" "2bt54"))
(list '("2bt61" "2bt61") '("2bt62" "2bt62") '("2bt63" "2bt63") '("2bt64" "2bt64"))
(list '("2bt71" "2bt71") '("2bt72" "2bt72") '("2bt73" "2bt73") '("2bt74" "2bt74"))
(list '("2bt81" "2bt81") '("2bt82" "2bt82") '("2bt83" "2bt83") '("2bt84" "2bt84"))
(list '("2bt91" "2bt91") '("2bt92" "2bt92") '("2bt93" "2bt93") '("2bt94" "2bt94"))
)
(list
(list '("3bt01" "3bt01") '("3bt02" "3bt02") '("3bt03" "3bt03") '("3bt04" "3bt04"))
(list '("3bt11" "3bt11") '("3bt12" "3bt12") '("3bt13" "3bt13") '("3bt14" "3bt14"))
(list '("3bt21" "3bt21") '("3bt22" "3bt22") '("3bt23" "3bt23") '("3bt24" "3bt24"))
(list '("3bt31" "3bt31") '("3bt32" "3bt32") '("3bt33" "3bt33") '("3bt34" "3bt34"))
(list '("3bt41" "3bt41") '("3bt42" "3bt42") '("3bt43" "3bt43") '("3bt44" "3bt44"))
(list '("3bt51" "3bt51") '("3bt52" "3bt52") '("3bt53" "3bt53") '("3bt54" "3bt54"))
(list '("3bt61" "3bt61") '("3bt62" "3bt62") '("3bt63" "3bt63") '("3bt64" "3bt64"))
(list '("3bt71" "3bt71") '("3bt72" "3bt72") '("3bt73" "3bt73") '("3bt74" "3bt74"))
(list '("3bt81" "3bt81") '("3bt82" "3bt82") '("3bt83" "3bt83") '("3bt84" "3bt84"))
(list '("3bt91" "3bt91") '("3bt92" "3bt92") '("3bt93" "3bt93") '("3bt94" "3bt94"))
)
(list
(list '("4bt01" "4bt01") '("4bt02" "4bt02") '("4bt03" "4bt03") '("4bt04" "4bt04"))
(list '("4bt11" "4bt11") '("4bt12" "4bt12") '("4bt13" "4bt13") '("4bt14" "4bt14"))
(list '("4bt21" "4bt21") '("4bt22" "4bt22") '("4bt23" "4bt23") '("4bt24" "4bt24"))
(list '("4bt31" "4bt31") '("4bt32" "4bt32") '("4bt33" "4bt33") '("4bt34" "4bt34"))
(list '("4bt41" "4bt41") '("4bt42" "4bt42") '("4bt43" "4bt43") '("4bt44" "4bt44"))
(list '("4bt51" "4bt51") '("4bt52" "4bt52") '("4bt53" "4bt53") '("4bt54" "4bt54"))
(list '("4bt61" "4bt61") '("4bt62" "4bt62") '("4bt63" "4bt63") '("4bt64" "4bt64"))
(list '("4bt71" "4bt71") '("4bt72" "4bt72") '("4bt73" "4bt73") '("4bt74" "4bt74"))
(list '("4bt81" "4bt81") '("4bt82" "4bt82") '("4bt83" "4bt83") '("4bt84" "4bt84"))
(list '("4bt91" "4bt91") '("4bt92" "4bt92") '("4bt93" "4bt93") '("4bt94" "4bt94"))
)
(list
(list '("5bt01" "5bt01") '("5bt02" "5bt02") '("5bt03" "5bt03") '("5bt04" "5bt04"))
(list '("5bt11" "5bt11") '("5bt12" "5bt12") '("5bt13" "5bt13") '("5bt14" "5bt14"))
(list '("5bt21" "5bt21") '("5bt22" "5bt22") '("5bt23" "5bt23") '("5bt24" "5bt24"))
(list '("5bt31" "5bt31") '("5bt32" "5bt32") '("5bt33" "5bt33") '("5bt34" "5bt34"))
(list '("5bt41" "5bt41") '("5bt42" "5bt42") '("5bt43" "5bt43") '("5bt44" "5bt44"))
(list '("5bt51" "5bt51") '("5bt52" "5bt52") '("5bt53" "5bt53") '("5bt54" "5bt54"))
(list '("5bt61" "5bt61") '("5bt62" "5bt62") '("5bt63" "5bt63") '("5bt64" "5bt64"))
(list '("5bt71" "5bt71") '("5bt72" "5bt72") '("5bt73" "5bt73") '("5bt74" "5bt74"))
(list '("5bt81" "5bt81") '("5bt82" "5bt82") '("5bt83" "5bt83") '("5bt84" "5bt84"))
(list '("5bt91" "5bt91") '("5bt92" "5bt92") '("5bt93" "5bt93") '("5bt94" "5bt94"))
)
)
注册 发表于 2022-12-23 13:35
再请教一下，如何实现空格键执行上一个命令，而不是重复打开工具面板？劳烦您了
论坛逛的不勤快。以下是我目前自用的调整后的代码，就是最后面的cond判断执行，由原来的read改成了Vlax-Invoke-Method，我也是抄别人的，感觉后者是模拟了键盘输入命令名的操作，CAD记录下的上一步操作是你后来选中的命令，而不是面板命令，所以可以右键重复执行。
(setq *DOC* (vla-get-ActiveDocument (vlax-get-acad-object)));;这个可以放在通用库里，或者放在函数前面，比较常用和通用
(cond ;;新的命令判断方式,代码更短
((boundp (read (strcat "c:" cmd)))
;(princ "\n")
;;使用以下这句，右键重复的命令为面板
;(eval (read (strcat "(c:" cmd ")")))
;;使用以下这句，右键重复的命令为面板启动的程序
(Vlax-Invoke-Method *DOC* 'SendCommand (strcat cmd " "))
;;以下是上一句的两种实现方式
;(Vlax-Invoke-Method (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'SendCommand (strcat tt " "))
;(Vlax-Invoke-Method (Vlax-Get-Or-Create-Object "WScript.Shell" ) 'Sendkeys (strcat tt "{Enter}"))
)
((boundp (read cmd))
;(princ "\n")
;(eval (read (strcat "(" cmd ")")))
(Vlax-Invoke-Method *DOC* 'SendCommand (strcat "(" cmd ")" " "))
)
(t
;(princ "\n")
;(vl-cmdf cmd)
(Vlax-Invoke-Method *DOC* 'SendCommand (strcat cmd " "))
)
)
muai2010 发表于 2024-8-19 09:43
大佬。是不是只能单列或者单行，多列外加一个框或者多行外加一个框dcl是不是不能实现？意思如下图，这个 ...
时间有点久了，我手头在用的这个面板函数和引用函数都修改过，不好做测试，不过从我写的修改历史来看，应该是可以实现你说的要求的。
以下是我样例中的部分代码，参照红色的代码增加新的子列表就能增加多列或者多行，可以多个子列表
("命令组1"
(
"FUNC1 命令1"
"FUNC2 命令2"
"FUNC3 命令3"
"more-1 =汇总= (&W)"
)
(
"FUNC1x 命令1x"
"FUNC2x 命令2x"
"FUNC3x 命令3x"
)
)
(其他按钮...)
)
感谢提供源码！ 别劳神了，推荐你采用：
简单的自定面板函数
不错我喜欢这样的面板的 支持感谢分享源码 USER2128 发表于 2014-12-4 14:52
别劳神了，推荐你采用：
简单的自定面板函数
那个面板程序我也在用，两个的使用差不多。实现的面板界面有点区别，具体看个人喜好了。 都不错！感谢楼主提供源码了！院长，老迈，都有，各有千秋，用者凭各自喜欢 不错，对面板了解不多，正在学习中。 有这样的面板吗？可否发一个学习一下！这个是仲文玉的工具箱演示！ tianyi1230 发表于 2014-12-5 22:16 static/image/common/back.gif
有这样的面板吗？可否发一个学习一下！这个是仲文玉的工具箱演示！
这个也就DCL间的相互切换
lucas_3333 发表于 2014-12-5 22:38 static/image/common/back.gif
这个也就DCL间的相互切换
发一个简单的学习学习！