工具栏

ajunseo · 发表于 2022-5-13 09:42

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

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

渠辉 · 发表于 2022-5-13 15:54

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

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

[/code]

ajunseo · 发表于 2022-5-13 18:45

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

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

ajunseo · 发表于 2022-5-13 18:56

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

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

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

[提问] 工具栏