菜单重载问题请教

yulijin608

菜单程序运行两遍的时候出现错误提示“无效的过程调用和参数”，有没有办法实现不管菜单程序运行多少遍都不出错？

dchlmz

有呀，程序改一下，把你的程序贴出来呀。我这几天刚解决了这个问题

yulijin608

Dim TestMenu As AcadPopupMenu
Set TestMenu = currMenuGroup.Menus.Add("软件")
'为菜单项声明变量,测试用10个
Dim newMenuItem(0 To 19) As AcadPopupMenuItem
Dim PopMenuMacro(0 To 19) As String '赋值宏字符串并创建菜单项
PopMenuMacro(0) = Chr(3) + Chr(3) + Chr(95) + "Excel_To_Map" + Chr(32)

Set newMenuItem(0) = TestMenu.AddMenuItem(TestMenu.Count + 1, "导入", PopMenuMacro(0))

' 在菜单条上显示菜单
currMenuGroup.Menus.InsertMenuInMenuBar "软件", ""
ThisDrawing.SendCommand "fileopen " & "futu.dwg" + vbCrLf
ZoomAll Exit Sub
End Sub

dchlmz

不好意思,你的是VBA自动生成菜单,我还不太懂.我现在会CAD的菜单文件加载方法.也就是自己做一个*.MNU文件.自动加载并运行.

王咣生

Public Sub test() Dim myMenuName As String
myMenuName = "软件" '--------------------------------------------------------
Dim currMenuGroups As AcadMenuGroups
Set currMenuGroups = ThisDrawing.Application.MenuGroups
Dim currMenuGroup As AcadMenuGroup

Dim i As Integer
Dim strMenuGrpName As String

For i = 0 To currMenuGroups.Count - 1
Set currMenuGroup = currMenuGroups.Item(i)
strMenuGrpName = currMenuGroup.Name
MsgBox strMenuGrpName
If StrComp(strMenuGrpName, "ACAD", vbTextCompare) = 0 Then
Dim popMenus As AcadPopupMenus
Set popMenus = currMenuGroup.Menus
Dim popMenu As AcadPopupMenu

Dim bExist As Boolean
bExist = False

Dim strMenuName As String

Dim j As Integer
For j = 0 To popMenus.Count - 1

Set popMenu = popMenus.Item(j)
strMenuName = popMenu.Name

If StrComp(strMenuName, myMenuName, vbTextCompare) = 0 Then
' If popMenu.OnMenuBar = True Then
' popMenus.RemoveMenuFromMenuBar (myMenuName)
' End If
bExist = True
Exit For
End If
Next

If bExist = False Then
' Create the new menu
Dim newMenu As AcadPopupMenu
Set newMenu = currMenuGroup.Menus.Add(myMenuName)

' 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
popMenus.InsertMenuInMenuBar myMenuName, ""

End If

Exit For

End If
Next End Sub 现在不会有你说的问题了,但是有些疑问, popMenus.RemoveMenuFromMenuBar (myMenuName)不能彻底移除一个popMenu.

王咣生

修改了一下. Public Sub test() Dim myMenuName As String
myMenuName = "软件" '--------------------------------------------------------
Dim currMenuGroups As AcadMenuGroups
Set currMenuGroups = ThisDrawing.Application.MenuGroups
Dim currMenuGroup As AcadMenuGroup

Dim i As Integer
Dim strMenuGrpName As String

For i = 0 To currMenuGroups.Count - 1
Set currMenuGroup = currMenuGroups.Item(i)
strMenuGrpName = currMenuGroup.Name
MsgBox strMenuGrpName
If StrComp(strMenuGrpName, "ACAD", vbTextCompare) = 0 Then
Dim popMenus As AcadPopupMenus
Set popMenus = currMenuGroup.Menus
Dim popMenu As AcadPopupMenu

Dim bExist As Boolean
bExist = False

Dim strMenuName As String

Dim j As Integer
For j = 0 To popMenus.Count - 1

Set popMenu = popMenus.Item(j)
strMenuName = popMenu.Name

If StrComp(strMenuName, myMenuName, vbTextCompare) = 0 Then
' Call clearPopupMenuItem(popMenu)
If popMenu.OnMenuBar = False Then
popMenus.InsertMenuInMenuBar myMenuName, ""
End If
bExist = True
Exit For
End If
Next

If bExist = False Then
' Create the new menu
Dim newMenu As AcadPopupMenu
Set newMenu = currMenuGroup.Menus.Add(myMenuName)

' 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
popMenus.InsertMenuInMenuBar myMenuName, ""

End If

Exit For

End If
Next End Sub

yulijin608

多谢斑竹,献花一朵

王咣生

为什么不能彻底移除一个popMenu？



移除之后,下次循环还能找到?为什么?应该怎么做?

王咣生

再次请问如何彻底移除一个popMenu？ popMenus.RemoveMenuFromMenuBar (myMenuName) 移除之后,下次执行程序循环AcadPopupMenus还能找到myMenuName,为什么?应该怎么做真正地删除?

雪山飞狐_lzh

在AUtoCad的一次运行过程中无法移除，但是重新打开会消失