如何用VB 实现CAD添加菜单？

参股银行

CAD添加菜单：menuload--选择要添加的文件。

请问用VB能实现上述的操作不？

home

Sub Example_AddMenuItem()
    ' This example creates a new menu called TestMenu and inserts a menu item
    ' into it. The menu is then displayed on the menu bar.
    ' To remove the menu after execution of this macro, use the Customize Menu
    ' option from the Tools menu.
   
    Dim currMenuGroup As AcadMenuGroup
    Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
   
    ' Create the new menu
    Dim newMenu As AcadPopupMenu
    Set newMenu = currMenuGroup.Menus.Add("TestMenu")
   
    ' Add a menu item to the new menu
    Dim newMenuItem As AcadPopupMenuItem
    Dim openMacro As String
    ' Assign the macro string the VB equivalent of "ESC ESC _open "
    openMacro = Chr(3) & Chr(3) & Chr(95) & "open" & Chr(32)
   
    Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Open", openMacro)
   
    ' Display the menu on the menu bar
    newMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
   
End Sub

这里有个vba的例子，用vb应该也可以吧，没有测试

xmjiacad

不知道你的问题解决了没，VB也是可以实现的：

Dim menuNames As String
Dim menuCollection As AcadPopupMenus
Dim menu As AcadPopupMenu
 acadapp.AcadStartup
Set menuCollection = acadapp.MenuGroups.Item(0).Menus
menuNames = ""
For Each menu In menuCollection
menuNames = menu.Name
If menuNames = "KKS处理" Then
On Error Resume Next
menu.RemoveFromMenuBar
End If
Next menu
' 定义当前菜单组的变量
Dim currMenuGroup As AcadMenuGroup
Set currMenuGroup = acadapp. _
MenuGroups.Item(0)

' 创建新菜单
Dim newMenu As AcadPopupMenu
'---------------------------------------------------------------------------------------------
Set newMenu = currMenuGroup.Menus.Add("KKS处理")

' 声明表示菜单项的变量
Dim newMenuItem As AcadPopupMenuItem
Dim openMacro As String
openMacro = Chr(3) & Chr(3) & Chr(95) & "open" & Chr(32)
' 并创建菜单项
Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, _
"填充KKS码到块属性", openMacro)   '将菜单与宏对应

' 在菜单栏上显示菜单
On Error Resume Next
currMenuGroup.Menus.InsertMenuInMenuBar "KKS处理", ""
'-----------------------------------------------------

我们要做的主要内容就是openMacro的过程编写了

yznang

Public Sub CreateMenu()
On Error Resume Next
'用AutoCAD菜单组的第一项创建一个菜单组
Dim CurMenuGroup As Object
Set CurMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
'创建一个名为“CAD增强插件”的菜单项，设S为加速键
Dim NewMenu As Object
Set NewMenu = CurMenuGroup.Menus.Add("CAD增强插件(" + Chr(Asc("&")) + "S)")
'确定选择项的宏
Dim FlowMacro As String
'为宏分配命令
'即VBA中的 ESC ESC 设计流程
FlowMacro = Chr(3) & Chr(3) & "(vl-vbarun " & Chr(34) & "DefPipeSize" & Chr(34) & ")" & Chr(13)

'添加选择项到CAD增强插件菜单项中
Dim FlowMenuItem As Object
Dim SepaMenuItem As Object    '分隔符
Set FlowMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, Chr(Asc("&")) + "插入页码", FlowMacro)
Set SepaMenuItem = NewMenu.AddSeparator(NewMenu.Count + 1)
'创建子菜单
Dim SingleMenu As Object
Set SingleMenu = NewMenu.AddSubMenu(NewMenu.Count + 1, "横断面修改")
'将选择项添加到子菜单中
Dim SubMenuItem As Object
Dim SubMacro As String
SubMacro = Chr(3) & Chr(3) & "(vl-vbarun " & Chr(34) & "Start_HdmBz" & Chr(34) & ")" & Chr(13)
Set SubMenuItem = SingleMenu.AddMenuItem(SingleMenu.Count + 1, "横断面高程标注 ", SubMacro)

Set SepaMenuItem = NewMenu.AddSeparator(NewMenu.Count + 1)
'即VBA中的 ESC ESC 设计流程
FlowMacro = Chr(3) & Chr(3) & "(vl-vbarun " & Chr(34) & "AboutUs" & Chr(34) & ")" & Chr(13)
Set FlowMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, Chr(Asc("&")) + "关于", FlowMacro)
FlowMacro = Chr(3) & Chr(3) & "(vl-vbarun " & Chr(34) & "SetOption" & Chr(34) & ")" & Chr(13)
Set FlowMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, Chr(Asc("&")) + "设置", FlowMacro)

'在AutoCAd菜单条上显示新创建的菜单
NewMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
End Sub

'拷别人的，自己换用相应的方法就行了

houlinbo

怎么在前面加图标？