如何用VB 实现CAD添加菜单？
<p>CAD添加菜单：menuload--选择要添加的文件。</p><p>请问用VB能实现上述的操作不？</p> <p>Sub Example_AddMenuItem()<br/> ' This example creates a new menu called TestMenu and inserts a menu item<br/> ' into it. The menu is then displayed on the menu bar.<br/> ' To remove the menu after execution of this macro, use the Customize Menu<br/> ' option from the Tools menu.<br/> <br/> Dim currMenuGroup As AcadMenuGroup<br/> Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)<br/> <br/> ' Create the new menu<br/> Dim newMenu As AcadPopupMenu<br/> Set newMenu = currMenuGroup.Menus.Add("TestMenu")<br/> <br/> ' Add a menu item to the new menu<br/> Dim newMenuItem As AcadPopupMenuItem<br/> Dim openMacro As String<br/> ' Assign the macro string the VB equivalent of "ESC ESC _open "<br/> openMacro = Chr(3) & Chr(3) & Chr(95) & "open" & Chr(32)<br/> <br/> Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Open", openMacro)<br/> <br/> ' Display the menu on the menu bar<br/> newMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)<br/> <br/>End Sub<br/></p><p>这里有个vba的例子，用vb应该也可以吧，没有测试</p> <p>不知道你的问题解决了没，VB也是可以实现的：</p><p>Dim menuNames As String<br/>Dim menuCollection As AcadPopupMenus<br/>Dim menu As AcadPopupMenu<br/> acadapp.AcadStartup<br/>Set menuCollection = acadapp.MenuGroups.Item(0).Menus<br/>menuNames = ""<br/>For Each menu In menuCollection<br/>menuNames = menu.Name<br/>If menuNames = "KKS处理" Then<br/>On Error Resume Next<br/>menu.RemoveFromMenuBar<br/>End If<br/>Next menu<br/>' 定义当前菜单组的变量<br/>Dim currMenuGroup As AcadMenuGroup<br/>Set currMenuGroup = acadapp. _<br/>MenuGroups.Item(0)</p><p>' 创建新菜单<br/>Dim newMenu As AcadPopupMenu<br/>'---------------------------------------------------------------------------------------------<br/>Set newMenu = currMenuGroup.Menus.Add("KKS处理")</p><p>' 声明表示菜单项的变量<br/>Dim newMenuItem As AcadPopupMenuItem<br/>Dim openMacro As String<br/>openMacro = Chr(3) & Chr(3) & Chr(95) & "open" & Chr(32)<br/>' 并创建菜单项<br/>Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, _<br/>"填充KKS码到块属性", openMacro) '将菜单与宏对应</p><p>' 在菜单栏上显示菜单<br/>On Error Resume Next<br/>currMenuGroup.Menus.InsertMenuInMenuBar "KKS处理", ""<br/>'-----------------------------------------------------</p><p>我们要做的主要内容就是openMacro的过程编写了</p> <p>Public Sub CreateMenu()<br/>On Error Resume Next<br/>'用AutoCAD菜单组的第一项创建一个菜单组<br/>Dim CurMenuGroup As Object<br/>Set CurMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)<br/>'创建一个名为“CAD增强插件”的菜单项，设S为加速键<br/>Dim NewMenu As Object<br/>Set NewMenu = CurMenuGroup.Menus.Add("CAD增强插件(" + Chr(Asc("&")) + "S)")<br/>'确定选择项的宏<br/>Dim FlowMacro As String<br/>'为宏分配命令<br/>'即VBA中的 ESC ESC 设计流程<br/>FlowMacro = Chr(3) & Chr(3) & "(vl-vbarun " & Chr(34) & "DefPipeSize" & Chr(34) & ")" & Chr(13)</p><p>'添加选择项到CAD增强插件菜单项中<br/>Dim FlowMenuItem As Object<br/>Dim SepaMenuItem As Object '分隔符<br/>Set FlowMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, Chr(Asc("&")) + "插入页码", FlowMacro)<br/>Set SepaMenuItem = NewMenu.AddSeparator(NewMenu.Count + 1)<br/>'创建子菜单<br/>Dim SingleMenu As Object<br/>Set SingleMenu = NewMenu.AddSubMenu(NewMenu.Count + 1, "横断面修改")<br/>'将选择项添加到子菜单中<br/>Dim SubMenuItem As Object<br/>Dim SubMacro As String<br/>SubMacro = Chr(3) & Chr(3) & "(vl-vbarun " & Chr(34) & "Start_HdmBz" & Chr(34) & ")" & Chr(13)<br/>Set SubMenuItem = SingleMenu.AddMenuItem(SingleMenu.Count + 1, "横断面高程标注 ", SubMacro)</p><p>Set SepaMenuItem = NewMenu.AddSeparator(NewMenu.Count + 1)<br/>'即VBA中的 ESC ESC 设计流程<br/>FlowMacro = Chr(3) & Chr(3) & "(vl-vbarun " & Chr(34) & "AboutUs" & Chr(34) & ")" & Chr(13)<br/>Set FlowMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, Chr(Asc("&")) + "关于", FlowMacro)<br/>FlowMacro = Chr(3) & Chr(3) & "(vl-vbarun " & Chr(34) & "SetOption" & Chr(34) & ")" & Chr(13)<br/>Set FlowMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, Chr(Asc("&")) + "设置", FlowMacro)</p><p><br/>'在AutoCAd菜单条上显示新创建的菜单<br/>NewMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)<br/>End Sub</p><p></p><p>'拷别人的，自己换用相应的方法就行了</p> 怎么在前面加图标？
页:
[1]