工具栏

ajunseo

2. (defun createtoolbar (name sym bmp / file x)
   
3.   (setvar "cmdecho" 0)
   
4.   (vl-load-com)
   
5.   (if (menugroup "TEMPTOOLBAR") (command "menuunload" "TEMPTOOLBAR"))
   
6.   (alert "\n程序将自动创建"临时工具栏"，请稍后")
   
7.   (setq file (open "TEMPTOOLBAR.mnu" "W"))
   
8.   (foreach x (list "***MENUGROUP=TEMPTOOLBAR\n\n***TOOLBARS\n**TEMPTOOLBAR"
   
9.      "ID_TEMP001   [_Toolbar("临时工具栏", _Floating, _Hide, 10, 340, 1)]"
   
10.     (strcat "ID_TEMP011   [_Button("" name "", "" bmp "", "" bmp "")]^C^C" sym)
    
11.                
    
12.       )
    
13.     (princ (strcat x "\n") file)
    
14.   )
    
15.   (close file)
    
16.   (command "menuload" "TEMPTOOLBAR.mnu")
    
17.   (command "TOOLBAR" "临时工具栏" "S")
    
18.   (princ)
    
19. )
    
20. (createtoolbar "轴测图直线" "zline" "RCDATA_16_OSNEND"  )
    
21. ;(createtoolbar "红色" "tt" "co1.bmp"  )
    

(defun createtoolbar (name sym bmp / file x)<br />   (setvar "cmdecho" 0)<br />   (vl-load-com)<br />   (if (menugroup "TEMPTOOLBAR") (command "menuunload" "TEMPTOOLBAR"))<br />   (alert "\n程序将自动创建"临时<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a>栏"，请稍后")<br />   (setq file (open "TEMPTOOLBAR.mnu" "W"))<br />   (foreach x (list "***MENUGROUP=TEMPTOOLBAR\n\n***TOOLBARS\n**TEMPTOOLBAR"<br />      "ID_TEMP001   [_Toolbar("临时工具栏", _Floating, _Hide, 10, 340, 1)]"<br />     (strcat "ID_TEMP011   [_Button("" name "", "" bmp "", "" bmp "")]^C^C" sym)<br />                <br />       )<br />     (princ (strcat x "\n") file)<br />   )<br />   (close file)<br />   (command "menuload" "TEMPTOOLBAR.mnu")<br />   (command "TOOLBAR" "临时工具栏" "S")<br />   (princ)<br /> )<br /> (createtoolbar "轴测图直线" "zline" "RCDATA_16_OSNEND"  )<br /> ;(createtoolbar "红色" "tt" "co1.bmp"  )<br />

在论坛找了一段工具栏代码，但是不能增加多个按钮，请高手指导！

渠辉

2. (defun addToolbars (toolbarname lst / gxl-catchapply bitname toolbars index lst name name1 newtoolbar newtoolbarbutton macro)
   
3.   (defun gxl-catchapply (fun args / result)
   
4.     (if (not (vl-catch-all-error-p
   
5.                (setq result
   
6.                       (vl-catch-all-apply
   
7.                         (if (= 'sym (type fun))
   
8.                           fun
   
9.                           (function fun)
   
10.                         )
    
11.                         args
    
12.                       )
    
13.                )
    
14.              )
    
15.         )
    
16.       result
    
17.     )
    
18.   )
    
19.   (setq toolbars
    
20.          (vla-get-toolbars
    
21.            (vla-item (vla-get-menugroups (vlax-get-acad-object))
    
22.                      0
    
23.            )
    
24.          )
    
25.   )
    
26.   (if (setq newtoolbar
    
27.              (gxl-catchapply
    
28.                vla-item
    
29.                (list toolbars toolbarname)
    
30.              )
    
31.       )
    
32.     (vla-delete newtoolbar)
    
33.   )
    
34.   (setq newtoolbar (vla-add toolbars toolbarname))
    
35.   (foreach x lst
    
36.     (setq index 0
    
37.           name (car x)
    
38.           macro (cadr x)
    
39.           bitname (caddr x)
    
40.     )
    
41.     (cond ((= name "--") (vla-addseparator newtoolbar (1+ index)))
    
42.           (t
    
43.            (setq newtoolbarbutton
    
44.                   (gxl-catchapply
    
45.                     vla-addtoolbarbutton
    
46.                     (list newtoolbar
    
47.                           index
    
48.                           name
    
49.                           name
    
50.                           (strcat (chr 32) (chr 32) (chr 95) macro (chr 32))
    
51.                     )
    
52.                   )
    
53.            )
    
54.            (gxl-catchapply
    
55.              vla-setbitmaps
    
56.              (list newtoolbarbutton bitname bitname)
    
57.            )
    
58.           )
    
59.     )
    
60.     (setq index (1+ index))
    
61.   )
    
62.   (vla-put-visible newtoolbar :vlax-true)
    
63.   (princ)
    
64. )
    
65. [code]addToolbars   "文字工具3"
    
66.   '(("文字合并" "wzhb" "wwzhb.ico")
    
67.     ("文字对齐" "wzdq" "wwzdq.ico")
    
68.         ("--")
    
69.     ("文字编号" "wzbh" "wwzbh.ico")
    
70.    )
    
71. )

(defun addToolbars (toolbarname lst / gxl-catchapply bitname toolbars index lst name name1 newtoolbar newtoolbarbutton macro)<br />   (defun gxl-catchapply (fun args / result)<br />     (if (not (vl-catch-all-error-p<br />                (setq result<br />                       (vl-catch-all-apply<br />                         (if (= 'sym (type fun))<br />                           fun<br />                           (function fun)<br />                         )<br />                         args<br />                       )<br />                )<br />              )<br />         )<br />       result<br />     )<br />   )<br />   (setq toolbars<br />          (vla-get-toolbars<br />            (vla-item (vla-get-menugroups (vlax-get-acad-object))<br />                      0<br />            )<br />          )<br />   )<br />   (if (setq newtoolbar<br />              (gxl-catchapply<br />                vla-item<br />                (list toolbars toolbarname)<br />              )<br />       )<br />     (vla-delete newtoolbar)<br />   )<br />   (setq newtoolbar (vla-add toolbars toolbarname))<br />   (foreach x lst<br />     (setq index 0<br />           name (car x)<br />           macro (cadr x)<br />           bitname (caddr x)<br />     )<br />     (cond ((= name "--") (vla-addseparator newtoolbar (1+ index)))<br />           (t<br />            (setq newtoolbarbutton<br />                   (gxl-catchapply<br />                     vla-addtoolbarbutton<br />                     (list newtoolbar<br />                           index<br />                           name<br />                           name<br />                           (strcat (chr 32) (chr 32) (chr 95) macro (chr 32))<br />                     )<br />                   )<br />            )<br />            (gxl-catchapply<br />              vla-setbitmaps<br />              (list newtoolbarbutton bitname bitname)<br />            )<br />           )<br />     )<br />     (setq index (1+ index))<br />   )<br />   (vla-put-visible newtoolbar :vlax-true)<br />   (princ)<br /> )<br /> [code]addToolbars   "文字工具3"<br />   '(("文字合并" "wzhb" "wwzhb.ico")<br />     ("文字对齐" "wzdq" "wwzdq.ico")<br />         ("--")<br />     ("文字编号" "wzbh" "wwzbh.ico")<br />    )<br /> )

[/code]

ajunseo

渠辉 发表于 2022-5-13 15:54
[/code]

非常不错，感谢大神的帮助！

ajunseo

渠辉 发表于 2022-5-13 15:54
[/code]

试了下，感觉输入命令会重复呢？可以改进下吗？