关于屏幕菜单重定制的疑问

gogogo168

我想用vba程序重新定制屏幕菜单，使它实现我自己定制的功能，但是这方面的资料太少了，不知道哪位大哥知道，，能不能给点提示或示例代码，多谢大家了!!

yao2001xp

Public Sub createmenu()
Dim menugroupobject As AcadMenuGroup
Dim menuobject As AcadPopupMenu
Dim submenuobject1 As AcadPopupMenu
Dim submenuobject2 As AcadPopupMenu
Dim menuitemobject As AcadPopupMenuItem
Set menugroupobject = ThisDrawing.Application.MenuGroups.Item(0)
On Error Resume Next
Set menuobject = menugroupobject.Menus.Add("newdimensions")
Set submenuobject1 = menuobject.AddSubMenu(0, "linear")
Set submenuobject2 = menuobject.AddSubMenu(1, "angular")
Set menuitemobject = submenuobject1.AddMenuItem(menuobject.Count + 1, "aligned", "-vbarun thisdrawing.aligneddimension" & vbCr)
Set menuitemobject = submenuobject1.AddMenuItem(menuobject.Count + 1, "ordinate", "-vbarun thisdrawing.aordinatedimension" & vbCr)
Set menuitemobject = submenuobject1.AddMenuItem(menuobject.Count + 1, "rotated", "-vbarun thisdrawing.rotatedimension" & vbCr)
Set menuitemobject = submenuobject2.AddMenuItem(menuobject.Count + 1, "Angular", "-vbarun thisdrawing.angulardimension" & vbCr)
Set menuitemobject = submenuobject2.AddMenuItem(menuobject.Count + 1, "diametric", "-vbarun thisdrawing.diametricdimension" & vbCr)
Set menuitemobject = submenuobject2.AddMenuItem(menuobject.Count + 1, "radial", "-vbarun thisdrawing.radialdimension" & vbCr)

menuobject.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)

End Sub

 

gogogo168

多谢你的代码，，我收下仔细研读了！！！有什么问题再请教你

gogogo168

我说的是屏幕菜单，不是普通的菜单。。在绘图区域，点击右键，选择选项，在显示选项卡上面有“显示屏幕菜单”的选项。选中就会出现屏幕菜单，现在的问题是如何自定制屏幕菜单？？？

gogogo168

自己问题，自己回答！！！用记事本打开acad.mnu文件，找到***.screen，改写自己的菜单内容！！！！然后加载之！！！不过，要注意，最好另存acad.mnu,以免破坏autocad本身的系统。同样的，也可以加写自己的图象菜单，可以看图象做选择，同样在acad.mnu中，找到***.image，在下面添加自己的图象菜单。

he993

那怎样用VB调出自己编写的屏幕菜单？能否指点一下，谢谢！