VBA CAD 菜单制作攻略

 

 

1。首先写好 一个dvb文件。

这个dvb文件中包含，菜单建立功能，例如：

Public Sub SetupMenu()
Dim currMenuGroup As AcadMenuGroup
    Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
    
    '创建新的菜单
    Dim newMenu As AcadPopupMenu
    Set newMenu = currMenuGroup.Menus.Add("智能展点系统(&S)")
                   
        '添加一个菜单项的子菜单
        Dim newMenuItem As AcadPopupMenuItem
        Dim openMacro As String
        Dim FileSubMenu As AcadPopupMenu
        '添加子菜单
        
        ' 将宏指定字符串相当于 ESC ESC _open
        openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Draw500Points" & Chr(32)
       Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "ABC", openMacro)
       
       openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Draw1000Points" & Chr(32)
       Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "ABA", openMacro)
       
        openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN Draw2000Points" & Chr(32)
       Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "ABD", openMacro)
              
         openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN MapTurn" & Chr(32)
       Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "ABC", openMacro)
             
         Set newMenuItem = newMenu.AddSeparator(newMenu.Count)
             
     Set FileSubMenu = newMenu.AddSubMenu(newMenu.Count + 1, "绘制2D实体")

            
        openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN MkLine" & Chr(32)
        Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "绘制直线(&L)", openMacro)
        
        openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN MkPolyline" & Chr(32)
        Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "绘制多段线(&P)", openMacro)
    
         openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN MkCircle" & Chr(32)
        Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.Count + 1, "绘制圆(&C)", openMacro)
        
          openMacro = Chr(3) & Chr(3) & Chr(95) & "-VBARUN AboutMe" & Chr(32)
       Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "&About", openMacro)
       Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "&Open File...", openMacro)
   
    '显示菜单栏上的的菜单
    newMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
End Sub

2。查找并 修改acad.lsp

例如cad 2004 修改acad2004.lsp

这个文件一般在目录C:\Program Files\AutoCAD 2004\Support

 

在该文件中加入以下语句：

(defun S::STARTUP()
(command "_VBALOAD" "SmartSystem.dvb")
(command "_-VBARUN" "SetupMenu"))

 

3。拷贝

SmartSystem.dvb为dvb文件名，然后把这个文件拷贝到cad的默认搜索目录，如C:\Program Files\AutoCAD 2004\Support

 

这样就能cad就能自动启动加载项了。