工具栏
(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 "
(strcat "ID_TEMP011 ^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")
在论坛找了一段工具栏代码，但是不能增加多个按钮，请高手指导！
(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)
)
addToolbars "文字工具3"
'(("文字合并" "wzhb" "wwzhb.ico")
("文字对齐" "wzdq" "wwzdq.ico")
("--")
("文字编号" "wzbh" "wwzbh.ico")
)
) 渠辉 发表于 2022-5-13 15:54
非常不错，感谢大神的帮助！ 渠辉 发表于 2022-5-13 15:54
试了下，感觉输入命令会重复呢？可以改进下吗？
页:
[1]