# 給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 SubView Code 寫幾個事件驅(qū)動菜單顯示 ? ![]() 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 SubView Code ?最終效果 ? 來源:http://www./content-4-220601.html |
|