找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1890|回复: 1

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

[复制链接]
发表于 2014-2-22 11:54:52 | 显示全部楼层 |阅读模式
悬赏200D豆未解决
下面是我创建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

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
 楼主| 发表于 2014-2-23 14:46:57 | 显示全部楼层
自己解决了,代码如下:
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
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-9-28 09:28 , Processed in 0.252950 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表