标签:this mamicode sig image load app private dba win
# 给cad添加自定义菜单
1 Private Sub AddBar() 2 Dim NewMenuItem As AcadPopupMenuItem 3 Dim TheMacro As String 4 Dim MI As Integer 5 6 On Error Resume Next 7 Dim currMenuGroup As AcadMenuGroup 8 Set currMenuGroup = Application.MenuGroups.Item(0) 9 ‘Create the new menu 10 Set NewMenu = currMenuGroup.Menus.Add("批量绘图") 11 If Err.Number Then 12 Err.Clear 13 For Each NewMenu In currMenuGroup.Menus 14 If NewMenu.Name = "批量绘图" Then Exit For 15 Next 16 End If 17 18 ‘Add a menu item to the new menu 19 ‘Assign the macro string the VB equivalent of "ESC ESC _open " 20 ‘TheMacro = Chr(3) & Chr(3) & Chr(95) & "-vbarun ""GeoSection.dvb!DZPM.GeoSection""" & Chr(32) 21 TheMacro = Chr(3) & Chr(3) & Chr(95) & "-vbarun ""MainSub""" & Chr(32) 22 Set NewMenuItem = NewMenu.AddMenuItem(NewMenu.Count + 1, "批量绘图", TheMacro) 23 If Err.Number Then Err.Clear 24 ‘Display the menu on the menu bar 25 NewMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1) 26 If Err.Number Then Err.Clear 27 End Sub
写几个事件驱动菜单显示
1 Private Sub AcadDocument_BeginCommand(ByVal CommandName As String) 2 If StrComp(Left$(CommandName, 3), "VBA", 1) <> 0 And UCase$(CommandName) <> "APPLOAD" Then Exit Sub 3 If NewMenu Is Nothing Then AddBar 4 End Sub 5 6 Private Sub AcadDocument_EndCommand(ByVal CommandName As String) 7 If StrComp(Left$(CommandName, 3), "VBA", 1) <> 0 And UCase$(CommandName) <> "APPLOAD" Then Exit Sub 8 If NewMenu Is Nothing Then AddBar 9 End Sub 10 11 Public Sub MainSub() 12 Dim frm As New UserForm1 13 Call UserForm1.Show 14 End Sub
最终效果
标签:this mamicode sig image load app private dba win
原文地址:https://www.cnblogs.com/NanShengBlogs/p/10957730.html