通用多层面板

lostbalance · 发表于 2014-12-3 20:01

好久没发帖了，最近学习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))
)
)
)
)

;;示例qq 
(defun c:qq ( / titl titl0 msg lst switch 
        main more-1 more-2 
        more-3 more-4 more-5 ) 
  ;通用定义 
  (setq titl0 "xx<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a>箱 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:31

本帖最后由 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"))
)
)

(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")) 
      ) 
    )

lostbalance · 发表于 2022-12-30 22:32

注册发表于 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 " "))
)
)

注册 · 发表于 2022-12-23 13:02

lostbalance 发表于 2022-12-23 11:26
之前第二句少了个右括号，补上再试试。

(setq title0 (strcat "阳羡刚刚好CAD工具箱 V20221212 " date ...

      ;通用定义
      (setq datestr (menucmd "m=$(edtime,$(getvar,date),YYYY年M月D日 HH:MM:SS DDD)"))
      (setq title0 (strcat "阳羡刚刚好CAD工具箱 V20221212 " datestr))
      (setq msg
               (strcat
                     "\n EDIT BY 阳羡刚刚好" datestr
               )
      )
      (setq switch "main 主板(&Z)")
貌似还是不行，还是谢谢你了

434939575 · 发表于 2014-12-3 22:59

感谢提供源码！

USER2128 · 发表于 2014-12-4 14:52

别劳神了，推荐你采用：
简单的自定面板函数

love1030312 · 发表于 2014-12-4 16:42

不错我喜欢这样的面板的支持感谢分享源码

lostbalance · 发表于 2014-12-4 17:30

USER2128 发表于 2014-12-4 14:52
别劳神了，推荐你采用：
简单的自定面板函数

那个面板程序我也在用，两个的使用差不多。实现的面板界面有点区别，具体看个人喜好了。

tianyi1230 · 发表于 2014-12-5 08:28

都不错！感谢楼主提供源码了！院长，老迈，都有，各有千秋，用者凭各自喜欢

zbwei120 · 发表于 2014-12-5 11:47

不错，对面板了解不多，正在学习中。

tianyi1230 · 发表于 2014-12-5 22:16

有这样的面板吗？可否发一个学习一下！这个是仲文玉的工具箱演示！

lucas_3333 · 发表于 2014-12-5 22:38

tianyi1230 发表于 2014-12-5 22:16
有这样的面板吗？可否发一个学习一下！这个是仲文玉的工具箱演示！

这个也就DCL间的相互切换

tianyi1230 · 发表于 2014-12-6 08:33

lucas_3333 发表于 2014-12-5 22:38
这个也就DCL间的相互切换

发一个简单的学习学习！

账号		自动登录	找回密码
密码			注册

[源码] 通用多层面板

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

相关帖子

本帖子中包含更多资源

本帖子中包含更多资源