如何在CAD中自己做一个菜单

haitu

   本人在CAD的内嵌VBA环境中用窗体实现了某些功能，现在需要一个菜单和这个窗体关联，在选择菜单后调出该窗体，请问如何添加~~

songzhi

看看这个

Private Sub AddExtMenu()
   
    On Error Resume Next
   
    Dim CurrMenuGroup As AcadMenuGroup
    Dim menuPopupItem As AcadPopupMenuItem
    Dim newMenu As AcadPopupMenu
    Dim menuSp As AcadPopupMenuItem
    Dim menuErase As AcadPopupMenu
   
    Dim strMacro As String
    Dim macro As String
   
    Set CurrMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
    Set newMenu = CurrMenuGroup.Menus.Add("编程(" & Chr(Asc("&")) & "P)")
   
    macro = Chr(vbKeyEscape) + Chr(vbKeyEscape) & Chr(16) & "-vbarun" + Chr(32) & "ThisDrawing.setasInner" & Chr(32)
    strMacro = "内轮廓(" & Chr(Asc("&")) & "N)"
    Set menuPopupItem = newMenu.AddMenuItem(newMenu.count + 1, strMacro, macro)
    
    Set menuSp = newMenu.AddSeparator(newMenu.count + 1)
   
    Set menuErase = newMenu.AddSubMenu(newMenu.count + 1, "删除引线")
   
    '屏幕指定
    macro = Chr(vbKeyEscape) + Chr(vbKeyEscape) & Chr(16) & "-vbarun" + Chr(32) & "ThisDrawing.EraseLeadLines" & Chr(32)
    strMacro = "选择(" & Chr(Asc("&")) & "S)"
    Set menuPopupItem = menuErase.AddMenuItem(menuErase.count + 1, strMacro, macro)
   
    '删除所有的引入引出线
    macro = Chr(vbKeyEscape) + Chr(vbKeyEscape) & Chr(16) & "-vbarun" + Chr(32) & "ThisDrawing.EraseAllLeadLines" & Chr(32)
    strMacro = "全部(" & Chr(Asc("&")) & "E)"
    Set menuPopupItem = menuErase.AddMenuItem(newMenu.count + 1, strMacro, macro)
   
    Set menuSp = newMenu.AddSeparator(newMenu.count + 1)
    'AutoPRO
    macro = Chr(vbKeyEscape) + Chr(vbKeyEscape) & Chr(16) & "-vbarun" + Chr(32) & "ThisDrawing.Programing" & Chr(32)
    strMacro = "数控编程(" & Chr(Asc("&")) & "A)"
    Set menuPopupItem = newMenu.AddMenuItem(newMenu.count + 1, strMacro, macro)
   
    macro = Chr(vbKeyEscape) + Chr(vbKeyEscape) & Chr(16) & "-vbarun" + Chr(32) & "ThisDrawing.Trial" & Chr(32)
    strMacro = "模拟切割(" & Chr(Asc("&")) & "T)"
    Set menuPopupItem = newMenu.AddMenuItem(newMenu.count + 1, strMacro, macro)
    'menuPopupItem.Enable = False
   
    Set menuSp = newMenu.AddSeparator(newMenu.count + 1)
   
    macro = Chr(vbKeyEscape) + Chr(vbKeyEscape) & Chr(16) & "-vbarun" + Chr(32) & "ThisDrawing.NC_DrawFile" & Chr(32)
    strMacro = "NC->图形(" & Chr(Asc("&")) & "D)"
    Set menuPopupItem = newMenu.AddMenuItem(newMenu.count + 1, strMacro, macro)
   
    Set menuSp = newMenu.AddSeparator(newMenu.count + 1)
   
    macro = Chr(vbKeyEscape) + Chr(vbKeyEscape) & Chr(16) & "-vbarun" + Chr(32) & "ThisDrawing.About" & Chr(32)
    strMacro = "关于(" & Chr(Asc("&")) & "B)..."
    Set menuPopupItem = newMenu.AddMenuItem(newMenu.count + 1, strMacro, macro)
   
    '显示菜单
    newMenu.InsertInMenuBar ThisDrawing.Application.MenuBar.count - 1
   
    '释放对象
    Set menuSp = Nothing
    Set CurrMenuGroup = Nothing
    Set newMenu = Nothing
    Set menuPopupItem = Nothing
    Set menuErase = Nothing
   
End Sub

macula

userform.show

haitu

多谢多谢啊~~~~