使用VBA向AutoCAD中添加新的菜單，涉及以下操作，創(chuàng)建新的菜單，使用Add方法向PopMenus集合添加新的PopMenu對(duì)象，向菜單中添加新的菜單項(xiàng)；使用AddMenuItem方法；向菜單中添加分隔符，使用AddSeperator方法；通過VBA為菜單項(xiàng)指定加速鍵，使用給定菜單項(xiàng)的Label屬性；添加級(jí)聯(lián)子菜單，使用AddSubmenu方法創(chuàng)建子菜單；要?jiǎng)h除菜單中的菜單項(xiàng)使用該菜單項(xiàng)的Delete方法。

Sub addasubmenu()
    Dim currmenugroup As AcadMenuGroup
    Set currmenugroup = ThisDrawing.Application.MenuGroups.Item(0)
    Dim newmenu As AcadPopupMenu
    Set newmenu = currmenugroup.Menus.Add("mmymen" & Chr(Asc("&")) & "u")
    Dim macro As String
    macro = Chr(vbKeyEscape) + Chr(vbKeyEscape)
    Dim menuitemopen As AcadPopupMenuItem
    Set menuitemopen = newmenu.AddMenuItem(newmenu.Count + 1, Chr(Asc("&")) & "openfile", macro & "_open")
    menuitemopen.HelpString = "打開圖形文件"
    Dim menuitemclose As AcadPopupMenuItem
    Set menuitemclose = newmenu.AddMenuItem(newmenu.Count + 1, Chr(Asc("&")) & "CloseFile", macro & "_close")
    menuitemclose.HelpString = "關(guān)閉圖形文件"
    Dim menuitemsepatator As AcadPopupMenuItem
    Set menuitemseparator = newmenu.AddSeparator("")
    Dim menuitemdraw As AcadPopupMenu
    Set menuitemdraw = newmenu.addsubmenu(newmenu.Count + 1, Chr(Asc("&")) & "Draw")
    Dim submenuitemline As AcadPopupMenuItem
    Set submenuitemline = menuitemdraw.AddMenuItem(menuitemdraw.Count + 1, Chr(Asc("&")) & "line", macro & "_line")
    Dim submenuitemarc As AcadPopupMenuItem
    Set submenuitemarc = menuitemdraw.AddMenuItem(menuitemdraw, Count + 1, Chr(Asc("&")) & "Arc", macro & "_arc")
    Dim submenuitemcircle As AcadPopupMenuItem
    Set submenuitemcircle = menuitemdraw.AddMenuItem(menuitemdraw.Count + 1, Chr(Asc("&")) & "Circle", macro & "-vbarun" + Chr(32) + "thisdrawing.drawcircle" + Chr(32))
    Dim menuitemdim As AcadPopupMenu
    Set menuitemdim = newmenu.addsubmenu(newmenu.Count + 1, "dimensio" & Chr(Asc("&")) & "n")
    Dim submenuitemaligned As AcadPopupMenuItem
    Set submenuitem = menuitemdim.AddMenuItem(menuitemdim.Count + 1, "dimali" & Chr(Asc("&")) & "gned", macro & "_dimaligned")
    Dim submenuitemlinear As AcadPopupMenuItem
    Set submenuitemlinear = menuitemdim.AddMenuItem(menuitemdim.Count + 1, "Dim" & Chr(Asc("&")) & "Linear", macro & "_dimLinear")
    Dim submenuitemordinate As AcadPopupMenuItem
    Set submenuitemordinate = menuitemdim.AddMenuItem(menuitemdim.Count + 1, "Dim" & Chr(Asc("&")) & "ordinate", macro & "_dimordinate")
    newmenu.insertmenubar (ThisDrawing.Application.MenuBar.Count + 1)
    Dim scmenu As AcadPopupMenu
    Dim element As AcadPopupMenu
    For Each element In currmenugroup.Menus
        If element.ShortcutMenu – True Then
            Set scmenu = element
        End If
    Next element
    Dim scmenuitem As AcadPopupMenuItem
    Set scmenu = scmenu.AddMenuItem("", "測(cè)量距離", macro & "_dist")
End Sub
Sub drawcircle()
    Dim ptcen(0 To 2) As Double
    ptcen(0) = 200
    ptcen(1) = 200
    ptcen(2) = 0
    ThisDrawing.ModelSpace.AddCircle ptcen, 60
    ZoomExtents
End Sub

按F5鍵運(yùn)行程序，即可看到新添加的菜單。