下面的代码是“开口汇料0430.dvb”文件里面的添加菜单项,运行“huiliao”这个函数 Private Sub AcadDocument_EndCommand(ByVal CommandName As String) Dim i As Integer Dim ts As String, sta As String, sta1 As String, VBAProjectPath As String On Error GoTo errhand ' MsgBox CommandName If CommandName = "VBALOAD" Or CommandName = "VBAMAN" Or CommandName = "APPLOAD" Or CommandName = "COMMANDLINE" Then '启动时菜单的生成 ' 该示例创建一个名为开口汇料新菜单,并在其中插入一个菜单项。 ' 然后将菜单显示在菜单栏中。 ' 在执行完该宏后如果需要将该菜单删除,可从【工具】菜单的【自定义菜单】项中删除。 Dim currMenuGroup As AcadMenuGroup Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0) ' 创建新菜单 Dim newMenu As AcadPopupMenu Set newMenu = currMenuGroup.Menus.Add("开口汇料") sta = "" VBAProjectPath = "" For i = 1 To Application.VBE.VBProjects.Count ts = Application.VBE.VBProjects(i).FileName sta = InStrRev(ts, "\", , vbTextCompare) sta1 = Right(ts, Len(ts) - sta) If sta1 = "开口汇料0430.dvb" Then 'VBAProjectPath = ts 'Left(ts, sta) Exit For End If Next For i = 1 To Len(ts) If Mid(ts, i, 1) = "\" Then VBAProjectPath = VBAProjectPath & "/" Else VBAProjectPath = VBAProjectPath & Mid(ts, i, 1) End If Next ' 添加一个菜单项到新的菜单中 Dim newMenuItem As AcadPopupMenuItem Dim openMacro As String ' 指定宏字符串,该字符串相当于VB中的 "ESC ESC _open " openMacro = "-vbarun " & VBAProjectPath & "!ThisDrawing.huiliao " Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "开始汇料", openMacro) ' 显示菜单到菜单栏中 newMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1) End If
errhand: If Err.Number = 0 Or Err.Number = -2147024809 Then Else MsgBox Err.Description & Err.Number Err.Clear End If End Sub |