[编程交流] 使用VBA创建命令

;---DETAIL BUBBLE---
(defun c:insert-detbub-block (/ layerset)
(setq layerset (getvar "clayer"))
(setvar "clayer" "35")
(setq scaleset(/ 1 (getvar "cannoscalevalue")))
(setvar "ATTDIA" 0)
(setq ins-pt (getpoint "\nSelect Insertion Point: <0,0>"))
(if (= nil ins-pt) (setq ins-pt (list 805 553)) )
(command "-insert" "detail bubble" ins-pt scaleset scaleset "0")
(command "explode" (entlast))
(setvar "ATTDIA" 1)
(setvar "clayer" layerset)
(princ)
) ;defun

Sub Main()
   Dim retMenu As AcadPopupMenu
   Dim retMenuItem As AcadPopupMenuItem
   Const MainMenuName As String = "My&Menu" ' add an Ampersand in front of letter to make it a Hotkey
   Const SubMenuName As String = "My&SubMenu"
   ' either add new, or return existing main menu Item
   Set retMenu = AddMainMenu(MainMenuName) '' add (or GET) main menu item
   ' add some sub menu item to our main menu
   For I% = 1 To 4
     Set retMenuItem = AddMainMenuItem(retMenu, SubMenuName & Str$(I%), "TestSub")
   Next '
End Sub
Private Function AddMainMenu(strMenuName As String) As AcadPopupMenu
   ' adds a main menu to acad menus, or returns an existing menu with the same name
   Dim currMenuGroup As AcadMenuGroup
   Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item("ACAD")
   For I = 0 To currMenuGroup.Menus.Count - 1
       If currMenuGroup.Menus(I).Name = strMenuName Then
           Set AddMainMenu = currMenuGroup.Menus(I)
           Exit Function
       End If
   Next
   ' if we're still here, we didnt find the menu, so we'll add one
   Set AddMainMenu = currMenuGroup.Menus.Add(strMenuName)
    ' Display the menu on the menu bar
   AddMainMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
End Function
Private Function AddMainMenuItem(objMenu As AcadPopupMenu, strMenuItem As String, strMacroName As String) As AcadPopupMenuItem
   ' adds a sub menu item to the passed menu object
   ' the "strMenuIte" param is the name of ther menu, per VB xconvention, embed an ampersand "&"
   ' before the letter you want to be a hotkey
   ' The "strMacroName" is the name of the Subroutine you want called when the menu is selected
   Dim openMacro As String
   openMacro = "-VBARUN " & strMacroName & " " ' add a space to enmnu item to emulate the ENTER key]'
   Set AddMainMenuItem = objMenu.AddMenuItem(objMenu.Count + 1, strMenuItem, openMacro)
End Function
Sub TestSub()
   ' name of routine to call when menu item is selected
   MsgBox "your menu was just selected"
End Sub