通用按键二维 dcl 通用面板

admin1

1. ;通用按键二维面板
   
2. ;
   
3. ;
   
4. (defun BT-UI-BT(tit s / #BT-KS bt-dcl bt-format)
   
5.   (vl-load-com)
   
6.         (defun BT-FORMAT (tit s / i str);格式化               
   
7.                 (setq i 1)
   
8.                 (append
   
9.                         (list "btbt:button{horizontal_margin = none ;vertical_margin = none ;}";格式化按钮fixed_width = true ;width = 20;
   
10.                                 (strcat "BTUI:dialog{label = " (vl-prin1-to-string tit)";");标题
    
11.                                 (if(= 'str(type(setq str(car s))))
    
12.                                         (progn (setq s(cdr s))(strcat ":boxed_row{label=""str"";"))
    
13.                                         ":row{");如果是字符串
    
14.                         )
    
15.                         (apply 'append
    
16.                                 (mapcar
    
17.                                         '(lambda(a)
    
18.                                                  (append
    
19.                                                          (list
    
20.                                                                  (if (= 'str(type(setq str(car a))))
    
21.                                                                          (progn(setq a(cdr a))(strcat":boxed_column{label=""str"";"))
    
22.                                                                          ":column{")
    
23.                                                                  ;"children_fixed_height="true";"
    
24.                                                          ;"children_alignment="top";"
    
25.                                                          );如果是字符串
    
26.                                                          (mapcar
    
27.                                                                  '(lambda(b / c d)
    
28.                                                                                 (setq c (strcat ":btbt{label = " (if(=""(car b))""""(vl-prin1-to-string(car b))) " ; key = "(vl-prin1-to-string (strcat "bt" (setq d (itoa (setq i (1+ i))))))";}"))
    
29.                                                                                 (setq #BT-KS (append #BT-KS (list(cons d (cadr b)))))
    
30.                                                                                 c
    
31.                                                                         )
    
32.                                                                  a
    
33.                                                          )                                                 
    
34.                                                          (list "}")
    
35.                                                  )
    
36.                                          )
    
37.                                         s
    
38.                                 )                                       
    
39.                         )
    
40.                         (list "}"
    
41.                                 ":image{color=2;height=0.2;}"
    
42.                                 "ok_only;"
    
43.                                 "}"
    
44.                         )
    
45.                 )
    
46.         )       
    
47.         ;;-------------------------------------------------
    
48.         (defun BT-DCL (tit s / cmd f ff id ui)
    
49.                 (setq f (strcat (getenv "temp") "\\BTBT.DCL"))
    
50.                 (if (findfile f) (vl-file-delete f))
    
51.                 (setq ff (open f "W"))
    
52.                 (foreach x (BT-FORMAT tit s)
    
53.                         (princ (strcat x "\n") ff)
    
54.                 )
    
55.                 (close ff)
    
56.                 (setq ui (load_dialog f))
    
57.                 (if(not(new_dialog "BTUI" ui))(exit))
    
58.                 (foreach x #BT-KS
    
59.                         (action_tile (strcat "bt" (car x))
    
60.                                 (strcat "(done_dialog  " (car x)")")
    
61.                         )                       
    
62.                 )
    
63.                 (setq id (start_dialog))
    
64.                 (unload_dialog ui)
    
65.                 (vl-file-delete f)
    
66.                 (if (and (< 1 id)
    
67.                                         (setq cmd (assoc (itoa id) #BT-KS))
    
68.                                         (setq cmd (cdr cmd))
    
69.                                         (= 'str (type cmd))
    
70.                                         (read cmd)
    
71.                                 )
    
72.                         (vla-SendCommand (vla-get-ActiveDocument(vlax-get-acad-object)) (strcat cmd " "))
    
73.                         ;(print(strcat"你调用的命令为：" (if(= ""cmd)"空" cmd)))
    
74.                 )
    
75.         )
    
76.         (BT-DCL tit s)
    
77. )
    
78. ;;-------------------------------------------------
    

复制代码

admin1

1. 
   
2. 
   
3. 
   
4.         (defun c:tt()
   
5.                 (bt-ui-bt "标题" '(
   
6.                                                                                         ("工具1"("圆""c")("线""l"))
   
7.                                                                                         (("标注""dli")("工具4"""))
   
8.                                                                                 )
   
9.                
   
10.         ))
    
11. 
    
12. ;通用按键二维面板,小波简化版2023.1.8
    
13. (defun BT-UI-BT(tit s / #BT-KS bt-dcl bt-format)
    
14.         (defun BT-FORMAT (tit s / i str);格式化               
    
15.                 (setq i 1)
    
16.                 (append
    
17.                         (list "btbt:button{horizontal_margin = none ;vertical_margin = none ;}";格式化按钮fixed_width = true ;width = 20;
    
18.                                 (strcat "BTUI:dialog{label = " (vl-prin1-to-string tit)";");标题
    
19.                                 (if(= 'str(type(setq str(car s))))
    
20.                                         (progn (setq s(cdr s))(strcat ":boxed_row{label=""str"";"))
    
21.                                         ":row{");如果是字符串
    
22.                         )
    
23.                         (apply 'append
    
24.                                 (mapcar
    
25.                                         '(lambda(a)
    
26.                                                  (append
    
27.                                                          (list
    
28.                                                                  (if (= 'str(type(setq str(car a))))
    
29.                                                                          (progn(setq a(cdr a))(strcat":boxed_column{label=""str"";"))
    
30.                                                                          ":column{")
    
31.                                                                  ;"children_fixed_height="true";"
    
32.                                                          ;"children_alignment="top";"
    
33.                                                          );如果是字符串
    
34.                                                          (mapcar
    
35.                                                                  '(lambda(b / c d)
    
36.                                                                                 (setq c (strcat ":btbt{label = " (if(=""(car b))""""(vl-prin1-to-string(car b))) " ; key = "(vl-prin1-to-string (strcat "bt" (setq d (itoa (setq i (1+ i))))))";}"))
    
37.                                                                                 (setq #BT-KS (append #BT-KS (list(cons d (cadr b)))))
    
38.                                                                                 c
    
39.                                                                         )
    
40.                                                                  a
    
41.                                                          )                                                 
    
42.                                                          (list "}")
    
43.                                                  )
    
44.                                          )
    
45.                                         s
    
46.                                 )                                       
    
47.                         )
    
48.                         (list "}"
    
49.                                 ":image{color=2;height=0.2;}"
    
50.                                 "ok_only;"
    
51.                                 "}"
    
52.                         )
    
53.                 )
    
54.         )       
    
55.         ;;-------------------------------------------------
    
56.         (defun BT-DCL (tit s / cmd f ff id ui)
    
57.                 (setq f (strcat (getenv "temp") "\\BTBT.DCL"))
    
58.                 (if (findfile f) (vl-file-delete f))
    
59.                 (setq ff (open f "W"))
    
60.                 (foreach x (BT-FORMAT tit s)
    
61.                         (princ (strcat x "\n") ff)
    
62.                 )
    
63.                 (close ff)
    
64.                 (setq ui (load_dialog f))
    
65.                 (if(not(new_dialog "BTUI" ui))(exit))
    
66.                 (foreach x #BT-KS
    
67.                         (action_tile (strcat "bt" (car x))
    
68.                                 (strcat "(done_dialog  " (car x)")")
    
69.                         )                       
    
70.                 )
    
71.                 (setq id (start_dialog))
    
72.                 (unload_dialog ui)
    
73.                 (vl-file-delete f)
    
74.                 (if (and (< 1 id)
    
75.                                         (setq cmd (assoc (itoa id) #BT-KS))
    
76.                                         (setq cmd (cdr cmd))
    
77.                                         (= 'str (type cmd))
    
78.                                         (read cmd)
    
79.                                 )
    
80.                         (vla-SendCommand (vla-get-ActiveDocument(vlax-get-acad-object)) (strcat cmd " "))
    
81.                         ;(print(strcat"你调用的命令为：" (if(= ""cmd)"空" cmd)))
    
82.                 )
    
83.         )
    
84.         (BT-DCL tit s)
    
85. )
    
86. ;;-------------------------------------------------
    

复制代码