求菜单的新建按钮添加在菜单上方的VBA代码
本帖最后由 清风明月名字 于 2014-2-22 11:58 编辑下面是我创建LSP插件启动按钮的代码，运行完全正常。
但我总有些不汇总它，因为它总是将最新的按钮生成在最下方，我要求最新按钮生成在上方，即从下而上，按钮的运行时间是从早到新。且要求，如果想创建的新按钮A，在下方某处已有，则删除下方的，新按钮A放在是上方。
求高手帮我写一下。
Function 在小多中创建按钮(程序文件简单名, 发送的窗口命令)
On Error Resume Next
Dim currMenuGroup As AcadMenuGroup
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
Dim newMenu As AcadPopupMenu
'下面是创建菜单“小多”
Set newMenu = currMenuGroup.Menus.Add("小多" & Chr(Asc("&")))
Set newMenu = currMenuGroup.Menus("小多" & Chr(Asc("&")))
Dim macro As String
macro = Chr(vbKeyEscape) + Chr(vbKeyEscape)
Dim subMenuItemPoint As AcadPopupMenuItem
'是如果存在以程序文件简单名为名的按钮，则删除它，再创建，以免同名而内容不同的错误
Set subMenuItemPoint = newMenu.Item(程序文件简单名)
subMenuItemPoint.Delete
'创建程序文件简单名为名的按钮,单击按钮时发出"-VBARUN XIANSHISHIYIANDAIMAYONGCHUANGTI "命令
Set subMenuItemPoint = newMenu.AddMenuItem(newMenu.Count + 1, Chr(Asc("&")) & 程序文件简单名, macro & 发送的窗口命令 & " ")
newMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
End Function
自己解决了，代码如下：
Function 在小多中创建按钮(程序文件简单名, 发送的窗口命令)
'用这个代码，新建的按钮在菜单上方，可容纳无数个按钮。命令重复的按钮会用最后一个
On Error Resume Next
Dim currMenuGroup As AcadMenuGroup
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
Dim newMenu As AcadPopupMenu
'下面是创建菜单“小多”
Set newMenu = currMenuGroup.Menus.Add("小多" & Chr(Asc("&")))
Set newMenu = currMenuGroup.Menus("小多" & Chr(Asc("&")))
Dim 数组 As New Dictionary
Dim macro As String
macro = Chr(vbKeyEscape) + Chr(vbKeyEscape)
Dim subMenuItemPoint As AcadPopupMenuItem
'这是增加新的按钮到数组中，如果原有命令冲突则会只剩下后加入的按钮
数组(macro & 发送的窗口命令 & " ") = Chr(Asc("&")) & 程序文件简单名
For Each TTT In newMenu
数组(TTT.macro) = TTT.Caption
Next TTT
'下为删除菜单上的所有按钮
For Each uuu In newMenu
uuu.Delete
Next uuu
'上为删除菜单上的所有按钮
For c = 0 To 数组.Count - 1
'创建程序文件简单名为名的按钮,单击按钮时发出"-VBARUN XIANSHISHIYIANDAIMAYONGCHUANGTI "命令
Set subMenuItemPoint = newMenu.AddMenuItem(newMenu.Count + 1, 数组.Items(c), 数组.Keys(c))
Next c
newMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1) '原代码
End Function 顶一下，支持源码！ 谢谢无私奉献，顶一下
页:
[1]