AutoCAD Net 根据代码添加Menu Bar或者Tool Bar

最终效果

 

整体思路

1.通过反射dll内部的所有的方法，找到有command method attribute的方法

2.通过com方法生成tool bar和menu bar

tool bar

 

menu bar

 

.处理事件和插件初始化加载

 

查看代码

 
Imports System.IO
Imports System.Reflection
 
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime
 
Public Class 插件初始化
    Implements Autodesk.AutoCAD.Runtime.IExtensionApplication
 
    Public Sub Initialize() Implements IExtensionApplication.Initialize
        Call AddCmdToToolBar()
        Call AddCmdToMenuBar()
        AddHandler Core.Application.SystemVariableChanged, Sub(sender, e)
                                                               If e.Name.ToUpper() = "WSCURRENT" Then
                                                                   Call AddCmdToToolBar()
                                                                   Call AddCmdToMenuBar()
                                                               End If
                                                           End Sub
    End Sub
 
    Public Sub Terminate() Implements IExtensionApplication.Terminate
        Throw New NotImplementedException()
    End Sub
 
 
    Public Sub AddCmdToMenuBar()
 
        If CInt(Application.GetSystemVariable("MenuBar")) = 0 Then Application.SetSystemVariable("MenuBar", 1)
        Dim dllName = Assembly.GetExecutingAssembly().ManifestModule.Name.Substring(0, Assembly.GetExecutingAssembly().ManifestModule.Name.Length - 4)
        Dim comApp = Application.AcadApplication
        Dim mg = Nothing
        Dim mcount = comApp.MenuGroups.Count
        For index = 0 To mcount - 1
            If comApp.MenuGroups.Item(index).Name = "ACAD" Then mg = comApp.MenuGroups.Item(index) : Exit For
        Next
        '创建弹出菜单
        Dim popMenu = Nothing
        For index = mg.Menus.Count - 1 To 0 Step -1
            If mg.Menus.Item(index).Name = dllName Then popMenu = mg.Menus.Item(index) : Exit For
        Next
        If popMenu Is Nothing Then
            popMenu = mg.Menus.Add(dllName)
            '提取全部的自定义命令
            Dim curAss = Assembly.GetExecutingAssembly()
            '提取全部的类型
            Dim clsCollection = curAss.GetTypes().Where(Function(t) t.IsClass And t.IsPublic)
            '提取含有cad自定义命令的方法
            Dim cmdMis As New List(Of MethodInfo)
            For Each item As Type In clsCollection
                cmdMis.AddRange(item.GetMethods().Where(Function(m) m.IsPublic And m.GetCustomAttribute(GetType(CommandMethodAttribute)) IsNot Nothing))
            Next
            For index = 0 To cmdMis.Count - 1
                Dim mi As MethodInfo = cmdMis(index)
                Dim att As CommandMethodAttribute = mi.GetCustomAttribute(GetType(CommandMethodAttribute), True)
                Dim cmdMacro = Chr(3) & Chr(3) & Chr(95) & att.GlobalName & Chr(32)
                popMenu.AddMenuItem(popMenu.Count + 1, mi.Name, cmdMacro)
            Next
        End If
        popMenu.InsertInMenuBar(mg.Menus.Count + 1)
    End Sub
 
 
    Public Sub AddCmdToToolBar()
        Dim dllName = Assembly.GetExecutingAssembly().ManifestModule.Name.Substring(0, Assembly.GetExecutingAssembly().ManifestModule.Name.Length - 4)
        Dim comApp = Application.AcadApplication
        Dim mg = Nothing
        Dim mcount = comApp.MenuGroups.Count
        For index = 0 To mcount - 1
            If comApp.MenuGroups.Item(index).Name = "ACAD" Then mg = comApp.MenuGroups.Item(index) : Exit For
        Next
        '创建工具条
        Dim toolBar = Nothing
        For index = mg.Toolbars.Count - 1 To 0 Step -1
            If mg.Toolbars.Item(index).Name = dllName Then toolBar = mg.Toolbars.Item(index) : Exit For
        Next
        If toolBar Is Nothing Then
            toolBar = mg.Toolbars.Add(dllName)
            '提取全部的自定义命令
            Dim curAss = Assembly.GetExecutingAssembly()
            '提取全部的类型
            Dim clsCollection = curAss.GetTypes().Where(Function(t) t.IsClass And t.IsPublic)
            '提取含有cad自定义命令的方法
            Dim cmdMis As New List(Of MethodInfo)
            For Each item As Type In clsCollection
                cmdMis.AddRange(item.GetMethods().Where(Function(m) m.IsPublic And m.GetCustomAttribute(GetType(CommandMethodAttribute)) IsNot Nothing))
            Next
            For index = 0 To cmdMis.Count - 1
                Dim mi As MethodInfo = cmdMis(index)
                Dim att As CommandMethodAttribute = mi.GetCustomAttribute(GetType(CommandMethodAttribute), True)
                'https://testguild.com/qtp-ascii-chr-code-chart/
                Dim cmdMacro = Chr(3) & Chr(3) & Chr(95) & att.GlobalName & Chr(32)
                'RetVal = object.AddToolbarButton(Index, Name, HelpString, Macro[, FlyoutButton]) 
                Dim iconName = Path.GetDirectoryName(Assembly.GetExecutingAssembly().Location) + "\001.bmp"
                With toolBar.AddToolbarButton(index, mi.Name, mi.Name, cmdMacro, False)
                    .SetBitmaps(iconName, iconName)
                End With
            Next
        End If
        toolBar.Dock(AcToolbarDockStatus.acToolbarDockRight)
        toolBar.Visible = True
    End Sub
    Public Enum AcToolbarDockStatus
        acToolbarDockTop = 0
        acToolbarDockBottom = 1
        acToolbarDockLeft = 2
        acToolbarDockRight = 3
        acToolbarFloating = 4
    End Enum
End Class