菜单的创建

圣歌

Module Module1
6 s+ Q6 r" i9 z* p  h) `- q7 H    Public Acadapp As AutoCAD.AcadApplication
4 B! Y  U( y1 X$ t" x: m4 i. z$ `    Sub 连接AutoCAD()
        On Error Resume Next
7 w  G- H8 n- e) R$ z3 T        Acadapp = GetObject(, "AutoCAD.Application")
        If Err.Number Then
2 i, S' G4 m3 Z, r$ d5 A            Err.Clear()
6 l1 ]7 H9 f* I, `$ g1 Z6 L1 Z: u: D            Acadapp = CreateObject("AutoCAD.Application")
            If Err.Number Then
) i7 l7 h! A  z6 F1 V                MsgBox("不能运行AutoCAD，请检查是否安装了AutoCAD")
. G4 `7 k# h8 S0 X; c/ b: `+ }                Exit Sub
& x1 N0 y0 O  f            End If
        End If
        Acadapp.Visible = True '界面可视
        Acadapp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
) r- c( x7 {9 @/ T& n8 W        AppActivate(Acadapp.Caption) '显示AutoCAD界面
    End Sub
    Sub main()
5 S3 p2 @! e& A+ c% d' S        Call 连接AutoCAD()
        Dim currMenuGroup As AutoCAD.AcadMenuGroup
# V" n% c) M5 [7 O) ^1 G5 h        currMenuGroup = Acadapp.Application.MenuGroups.Item(0)
        '创建新菜单
9 ?- I. E3 j( l( U        Dim NewMenu As AutoCAD.AcadPopupMenu
* r7 J* f- `+ a; ~. \  H, Y        NewMenu = currMenuGroup.Menus.Add("个性化菜单项（&B）")
9 b; m) X5 U6 g9 U        '注意，若AutoCAD菜单条已有一个同名菜单，则会报错。
7 c, ?8 t; l& d1 l        '在新菜单上添加菜单项
        Dim newMenuItem1 As AutoCAD.AcadPopupMenuItem
7 m7 m, a% t; y! g" W  ^8 v        Dim newMenuItem2 As AutoCAD.AcadPopupMenuItem
        Dim newMenuItem3 As AutoCAD.AcadPopupMenuItem
        Dim newMenuItem4 As AutoCAD.AcadPopupMenuItem
. O2 C! x& V0 _* f6 S9 _9 G: Y# \2 U        Dim newMenuItem5 As AutoCAD.AcadPopupMenuItem
  X( c- t( [, m2 _3 {        Dim openMacro1 As String
        Dim openMacro2 As String
( E) \& |# E- W7 U5 y        Dim openMacro3 As String
        Dim openMacro4 As String
        Dim openMacro5 As String
5 u7 n5 Q' m  G$ V/ ^4 B        '定义菜单宏
- O: _) W+ p9 m& x" N6 r        openMacro1 = Chr(3) & Chr(3) & "shell" & Chr(13) & "齿轮结构参数化三维造型.exe" & Chr(13)
7 A- Q! J$ F# q- M- Z/ Y        openMacro2 = Chr(3) & Chr(3) & "shell" & Chr(13) & "斜齿轮.exe" & Chr(13)
        openMacro3 = Chr(3) & Chr(3) & "shell" & Chr(13) & "尺寸公差自动标注.exe" & Chr(13)
        openMacro4 = Chr(3) & Chr(3) & "shell" & Chr(13) & "形位公差自动标注.exe" & Chr(13)
! u. Y8 ?" y" H( G, y' M, w1 R        openMacro5 = Chr(3) & Chr(3) & "shell" & Chr(13) & "Access数据库管理图形.exe" & Chr(13)
        '创建菜单项
1 r" a0 K1 E7 S  i: b/ y) F        newMenuItem1 = NewMenu.AddMenuItem(NewMenu.Count + 1, "齿轮结构参数化三维造型（&A）", openMacro1)
' W. D: I- q6 }2 O, E        newMenuItem2 = NewMenu.AddMenuItem(NewMenu.Count + 1, "斜齿轮（&C）", openMacro1)
        newMenuItem3 = NewMenu.AddMenuItem(NewMenu.Count + 1, "尺寸公差自动标注（&D）", openMacro1)
0 Z- Y% d5 d' n& n        newMenuItem4 = NewMenu.AddMenuItem(NewMenu.Count + 1, "形位公差自动标注（&E）", openMacro1)
1 s6 D1 B; R& p* D* P; E" O$ L. P        newMenuItem5 = NewMenu.AddMenuItem(NewMenu.Count + 1, "Access数据库管理图形（&F）", openMacro1)
        '在菜单条上显示菜单
' ~: e0 V5 n& r4 h( a        NewMenu.InsertInMenuBar(Acadapp.Application.MenuBar.Count + 1)
        Acadapp = Nothing
    End Sub
- |: E1 m- p0 I$ E; [End Module

wdn36409

拿来试试，表中格式符号可能有点麻烦。

落叶思枝

能介绍一下这是什么东西吗？该如何操作呢？

767697426

看这个头都大了
能解释一下干嘛的吗