求菜单的新建按钮添加在菜单上方的VBA代码

清风明月名字

下面是我创建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

vbcad

顶一下，支持源码！

jsxygshh

谢谢无私奉献，顶一下