vbnet 实现AutoCAD自定义菜单和工具栏

Imports System
Imports System.Collections.Generic
Imports System.Collections.Specialized
Imports System.Linq
Imports System.Text
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Customization
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Imports AutoCAD转.DotNetARX
Imports Autodesk.AutoCAD.Windows

Namespace CUIExample
    Public Class CUIExample
        Private ReadOnly cuiFile As String = Tools.GetCurrentPath() & "\MyCustom.cui"
        Private menuGroupName As String = "MyCustom"
        Private activeDoc As Document = Application.DocumentManager.MdiActiveDocument

        Public Sub New()
            AddHandler Application.QuitWillStart, New EventHandler(AddressOf Application_QuitWillStart)
        End Sub

        Private Sub Application_QuitWillStart(ByVal sender As Object, ByVal e As EventArgs)
            '’由于触发此事件前文档已关闭，所以需通过模板重建，以便命令能够执行
            Dim doc As Document = Application.DocumentManager.Add("acadiso.dwt")
            '’获取FILEDIA系统变量的值
            Dim oldFileDia As Object = Application.GetSystemVariable("FILEDIA")
            ''
            Application.SetSystemVariable("FILEDIA", 0)
            Dim mainCs As CustomizationSection = doc.GetMainCustomizationSection()
            If mainCs.PartialCuiFiles.Contains(cuiFile) Then doc.Editor.PostCommand("cuiunload " & menuGroupName & " ")
            Application.SetSystemVariable("FILEDIA", oldFileDia)
        End Sub

        <CommandMethod("AddMenu")>
        Public Sub AddMenu()
            Dim currentPath As String = Tools.GetCurrentPath()
            Dim cs As CustomizationSection = activeDoc.AddCui(cuiFile, menuGroupName)

            cs.AddMacro("直线", "^C^C_Line ", "ID_MyLine", "创建直线段:   LINE", currentPath & "\Image\Line.BMP")
            cs.AddMacro("多段线", "^C^C_Pline ", "ID_MyPLine", "创建二维多段线:  PLINE", currentPath & "\Image\Polyline.BMP")
            cs.AddMacro("矩形", "^C^C_Rectang ", "ID_MyRectang", "创建矩形多段线:  RECTANG", currentPath & "\Image\Rectangle.BMP")
            cs.AddMacro("圆", "^C^C_circle ", "ID_MyCircle", "用指定半径创建圆:   CIRCLE", currentPath & "\Image\Circle.BMP")
            cs.AddMacro("复制", "^C^CCopy ", "ID_MyCopy", "复制对象:   COPY", currentPath & "\Image\Copy.BMP")
            cs.AddMacro("删除", "^C^CErase ", "ID_MyErase", "从图形删除对象:   ERASE", currentPath & "\Image\Erase.BMP")
            cs.AddMacro("移动", "^C^CMove ", "ID_MyMove", "将对象在指定方向上平移指定的距离:  MOVE", currentPath & "\Image\Move.BMP")
            cs.AddMacro("旋转", "^C^CRotate ", "ID_MyRotate", "绕基点旋转对象:  ROTATE", currentPath & "\Image\Rotate.BMP")
            Dim sc As StringCollection = New StringCollection()
            sc.Add("MyPop1")
            Dim myMenu As PopMenu = cs.MenuGroup.AddPopMenu("我的菜单", sc, "ID_MyMenu")

            If myMenu IsNot Nothing Then
                myMenu.AddMenuItem(-1, "直线", "ID_MyLine")
                myMenu.AddMenuItem(-1, "多段线", "ID_MyPLine")
                myMenu.AddMenuItem(-1, "矩形", "ID_MyRectang")
                myMenu.AddMenuItem(-1, "圆", "ID_MyCircle")
                myMenu.AddSeparator(-1)
                Dim menuModify As PopMenu = myMenu.AddSubMenu(-1, "修改", "ID_MyModify")
                menuModify.AddMenuItem(-1, "复制", "ID_MyCopy")
                menuModify.AddMenuItem(-1, "删除", "ID_MyErase")
                menuModify.AddMenuItem(-1, "移动", "ID_MyMove")
                menuModify.AddMenuItem(-1, "旋转", "ID_MyRotate")
            End If

            cs.LoadCui()
        End Sub

        <CommandMethod("AddToolbar")>
        Public Sub AddToolbar()
            Dim currentPath As String = Tools.GetCurrentPath()
            Dim cs As CustomizationSection = activeDoc.AddCui(cuiFile, menuGroupName)
            cs.AddMacro("直线", "^C^CModalDialog ", "ID_MyLine", "创建直线段:   LINE", currentPath & "\Image\Line.BMP")
            cs.AddMacro("多段线", "^C^C_Pline ", "ID_MyPLine", "创建二维多段线:  PLINE", currentPath & "\Image\Polyline.BMP")
            cs.AddMacro("矩形", "^C^C_Rectang ", "ID_MyRectang", "创建矩形多段线:  RECTANG", currentPath & "\Image\Rectangle.BMP")
            cs.AddMacro("圆", "^C^C_circle ", "ID_MyCircle", "用指定半径创建圆:   CIRCLE", currentPath & "\Image\Circle.BMP")
            cs.AddMacro("复制", "^C^CCopy ", "ID_MyCopy", "复制对象:   COPY", currentPath & "\Image\Copy.BMP")
            cs.AddMacro("删除", "^C^CErase ", "ID_MyErase", "从图形删除对象:   ERASE", currentPath & "\Image\Erase.BMP")
            cs.AddMacro("移动", "^C^CMove ", "ID_MyMove", "将对象在指定方向上平移指定的距离:  MOVE", currentPath & "\Image\Move.BMP")
            cs.AddMacro("旋转", "^C^CRotate ", "ID_MyRotate", "绕基点旋转对象:  ROTATE", currentPath & "\Image\Rotate.BMP")

            Dim barDraw As Toolbar = cs.MenuGroup.AddToolbar("我的工具栏")
            barDraw.AddToolbarButton(-1, "直线", "ID_MyLine")
            barDraw.AddToolbarButton(-1, "多段线", "ID_MyPLine")
            barDraw.AddToolbarButton(-1, "矩形", "ID_MyRectang")
            barDraw.AddToolbarButton(-1, "圆", "ID_MyCircle")
            Dim barModify As Toolbar = cs.MenuGroup.AddToolbar("修改工具栏")
            Dim buttonCopy As ToolbarButton = barModify.AddToolbarButton(-1, "复制", "ID_MyCopy")
            Dim buttonErase As ToolbarButton = barModify.AddToolbarButton(-1, "删除", "ID_MyErase")
            Dim buttonMove As ToolbarButton = barModify.AddToolbarButton(-1, "移动", "ID_MyMove")
            Dim buttonRotate As ToolbarButton = barModify.AddToolbarButton(-1, "旋转", "ID_MyRotate")
            barDraw.AttachToolbarToFlyout(-1, barModify)
            cs.LoadCui()
        End Sub

        <CommandMethod("AddDoubleClick")>
        Public Sub AddDoubleClick()
            Dim cs As CustomizationSection = activeDoc.AddCui(cuiFile, menuGroupName)
            Dim macro As MenuMacro = cs.AddMacro("多段线 - 双击", "^C^C_DoubleClickPline ", "ID_PlineDoubleClick", "调用自定义命令", Nothing)
            Dim action As DoubleClickAction = New DoubleClickAction(cs.MenuGroup, "优化多段线", -1)
            action.ElementID = "EID_mydblclick"
            action.DxfName = RXClass.GetClass(GetType(Polyline)).DxfName
            Dim cmd As DoubleClickCmd = New DoubleClickCmd(action, macro)
            action.DoubleClickCmd = cmd
            cs.LoadCui()
        End Sub

        <CommandMethod("DoubleClickPline")>
        Public Sub DoubleClickPline()
            Application.ShowAlertDialog("你双击了多段线！")
        End Sub

        <CommandMethod("AddDefaultContextMenu")>
        Public Sub AddDefaultContextMenu()
            Dim contextMenu As ContextMenuExtension = New ContextMenuExtension()
            contextMenu.Title = "我的快捷菜单"
            Dim mi As MenuItem = New MenuItem("复制")
            AddHandler mi.Click, New EventHandler(AddressOf mi_Click)
            contextMenu.MenuItems.Add(mi)
            mi = New MenuItem("删除")
            AddHandler mi.Click, New EventHandler(AddressOf mi_Click)
            contextMenu.MenuItems.Add(mi)
            Application.AddDefaultContextMenuExtension(contextMenu)
        End Sub

        Private Sub mi_Click(ByVal sender As Object, ByVal e As EventArgs)
            Dim mi As MenuItem = TryCast(sender, MenuItem)

            If mi.Text = "复制" Then
                activeDoc.SendStringToExecute("_Copy ", True, False, True)
            ElseIf mi.Text = "删除" Then
                activeDoc.SendStringToExecute("_Erase ", True, False, True)
            End If
        End Sub
        Private Sub miCircle_Click(ByVal sender As Object, ByVal e As EventArgs)
            activeDoc.SendStringToExecute("_Count ", True, False, False)
        End Sub

        <CommandMethod("AddObjectContextMenu")>
        Public Sub AddObjectContextMenu()
            Dim contextMenu As ContextMenuExtension = New ContextMenuExtension()
            Dim miCircle As MenuItem = New MenuItem("统计个数")

            'miCircle.Click += Sub(ByVal sender As Object, ByVal e As EventArgs)
            '                      activeDoc.SendStringToExecute("_Count ", True, False, False)
            '                  End Sub

            AddHandler miCircle.Click, New EventHandler(AddressOf miCircle_Click)

            contextMenu.MenuItems.Add(miCircle)
            Dim rx As RXClass = RXClass.GetClass(GetType(Entity))
            Application.AddObjectContextMenuExtension(rx, contextMenu)
        End Sub

        <CommandMethod("Count", CommandFlags.UsePickSet)>
        Public Sub CountEnts()
            Dim ed As Editor = activeDoc.Editor
            Dim result As PromptSelectionResult = ed.SelectImplied()
            If result.Status = PromptStatus.OK Then ed.WriteMessage("共选择了" & result.Value.Count & "个实体" & vbLf)
        End Sub
    End Class
End Namespace

Imports System.Collections.Specialized
Imports System.IO
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Customization
Imports System.Runtime.CompilerServices
Imports Autodesk.AutoCAD.EditorInput

Namespace DotNetARX
    ''' <summary>
    ''' 操作CUI的类
    ''' </summary>
    Module CUITools
        ''' <summary>
        ''' 获取并打开主CUI文件
        ''' </summary>
        ''' <param name="doc">AutoCAD文档对象</param>
        ''' <returns>返回主CUI文件</returns>
        <Extension()>
        Function GetMainCustomizationSection(ByVal doc As Document) As CustomizationSection
            ''获得主CUI文件所在的位置
            Dim mainCuiFile As String = Application.GetSystemVariable("MENUNAME") & ".cui"
            mainCuiFile = "C:\Program Files\Autodesk\AutoCAD 2012 - Simplified Chinese\UserDataCache\Support\acad.CUIX"
            Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
            ed.WriteMessage(mainCuiFile)
            ''打开主CUI文件
            Return New CustomizationSection(mainCuiFile)
        End Function
        ''' <summary>
        ''' 创建局部CUI文件
        ''' </summary>
        ''' <param name="doc">AutoCAD文档对象</param>
        ''' <param name="cuiFile">CUI文件名</param>
        ''' <param name="menuGroupName">菜单组的名称</param>
        ''' <returns>返回创建的CUI文件</returns>
        <Extension()>
        Function AddCui(ByVal doc As Document, ByVal cuiFile As String, ByVal menuGroupName As String) As CustomizationSection
            Dim cs As CustomizationSection ''声明CUI文件对象

            If Not File.Exists(cuiFile) Then ''如果要创建的文件不存在
                cs = New CustomizationSection() ''创建CUI文件对象
                cs.MenuGroupName = menuGroupName ''指定菜单组名称
                cs.SaveAs(cuiFile) ''保存CUI文件
            Else
                ''如果已经存在指定的CUI文件，则打开该文件
                cs = New CustomizationSection(cuiFile)
            End If

            Return cs ''返回CUI文件对象
        End Function
        ''' <summary>
        ''' 装载指定的局部CUI文件
        ''' </summary>
        ''' <param name="cs">CUI文件</param>
        <Extension()>
        Sub LoadCui(ByVal cs As CustomizationSection)
            If cs.IsModified Then cs.Save() ''如果CUI文件被修改，则保存
            ''保存CMDECHO及FILEDIA系统变量
            Dim oldCmdEcho As Object = Application.GetSystemVariable("CMDECHO")
            Dim oldFileDia As Object = Application.GetSystemVariable("FILEDIA")
            ''设置CMDECHO=0，控制不在命令行上回显提示和输入信息
            Application.SetSystemVariable("CMDECHO", 0)
            ''设置FILEDIA=0，禁止显示文件对话框，这样可以通过程序输入文件名
            Application.SetSystemVariable("FILEDIA", 0)
            ''获取当前活动文档
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            ''获取主CUI文件
            Dim mainCs As CustomizationSection = doc.GetMainCustomizationSection()
            ''如果已存在局部CUI文件，则先卸载
            If mainCs.PartialCuiFiles.Contains(cs.CUIFileName) Then doc.SendStringToExecute("_.cuiunload " & cs.CUIFileBaseName & " ", False, False, False)
            ''装载CUI文件，注意文件名必须是带路径的
            doc.SendStringToExecute("_.cuiload " & cs.CUIFileName & " ", False, False, False)
            ''恢复CMDECHO及FILEDIA系统变量的初始值
            doc.SendStringToExecute("(setvar ""FILEDIA"" " & oldFileDia.ToString() & ")(princ) ", False, False, False)
            doc.SendStringToExecute("(setvar ""CMDECHO"" " & oldCmdEcho.ToString() & ")(princ) ", False, False, False)
        End Sub
        ''' <summary>
        ''' 添加菜单项所要执行的宏
        ''' </summary>
        ''' <param name="source">CUI文件</param>
        ''' <param name="name">宏的显示名称</param>
        ''' <param name="command">宏的具体命令</param>
        ''' <param name="tag">宏的标识符</param>
        ''' <param name="helpString">宏的状态栏提示信息</param>
        ''' <param name="imagePath">宏的图标</param>
        ''' <returns>返回创建的宏</returns>
        <Extension()>
        Function AddMacro(ByVal source As CustomizationSection, ByVal name As String, ByVal command As String, ByVal tag As String, ByVal helpString As String, ByVal imagePath As String) As MenuMacro
            Dim menuGroup As MenuGroup = source.MenuGroup ''获取CUI文件中的菜单组
            ''判断菜单组中是否已经定义与菜单组名相同的宏集合
            Dim mg As MacroGroup = menuGroup.FindMacroGroup(menuGroup.Name)
            ''如果宏集合没有定义，则创建一个与菜单组名相同的宏集合
            If mg Is Nothing Then mg = New MacroGroup(menuGroup.Name, menuGroup)
            ''如果已经宏已经被定义，则返回
            For Each macro As MenuMacro In mg.MenuMacros
                If macro.ElementID = tag Then Return Nothing
            Next
            ''在宏集合中创建一个命令宏
            Dim MenuMacro As MenuMacro = New MenuMacro(mg, name, command, tag)
            ''指定命令宏的说明信息，在状态栏中显示
            MenuMacro.macro.HelpString = helpString
            ''指定命令宏的大小图像的路径
            MenuMacro.macro.LargeImage = imagePath
            MenuMacro.macro.SmallImage = imagePath
            Return MenuMacro ''返回命令宏
        End Function
        ''' <summary>
        ''' 添加下拉菜单
        ''' </summary>
        ''' <param name="menuGroup">包含菜单的菜单组</param>
        ''' <param name="name">菜单名</param>
        ''' <param name="aliasList">菜单的别名</param>
        ''' <param name="tag">菜单的标识字符串</param>
        ''' <returns>返回下拉菜单对象</returns>
        <Extension()>
        Function AddPopMenu(ByVal menuGroup As MenuGroup, ByVal name As String, ByVal aliasList As StringCollection, ByVal tag As String) As PopMenu
            Dim pm As PopMenu = Nothing ''声明下拉菜单对象
            ''如果菜单组中没有名称为name的下拉菜单
            If menuGroup.PopMenus.IsNameFree(name) Then
                ''为下拉菜单指定显示名称、别名、标识符和所属的菜单组
                pm = New PopMenu(name, aliasList, tag, menuGroup)
            End If

            Return pm ''返回下拉菜单对象
        End Function
        ''' <summary>
        ''' 为菜单添加菜单项
        ''' </summary>
        ''' <param name="parentMenu">菜单项所属的菜单</param>
        ''' <param name="index">菜单项的位置</param>
        ''' <param name="name">菜单项的显示名称</param>
        ''' <param name="macroId">菜单项的命令宏的Id</param>
        ''' <returns>返回添加的菜单项</returns>
        <Extension()>
        Function AddMenuItem(ByVal parentMenu As PopMenu, ByVal index As Integer, ByVal name As String, ByVal macroId As String) As PopMenuItem
            Dim newPmi As PopMenuItem = Nothing
            ''如果存在名为name的菜单项，则返回
            For Each pmi As PopMenuItem In parentMenu.PopMenuItems
                If pmi.Name = name Then Return newPmi
            Next
            ''定义一个菜单项对象，指定所属的菜单及位置
            newPmi = New PopMenuItem(parentMenu, index)
            ''如果name不为空，则指定菜单项的显示名为name，否则会使用命令宏的名称
            If name IsNot Nothing Then newPmi.Name = name
            newPmi.MacroID = macroId ''菜单项的命令宏的ID
            Return newPmi ''返回菜单项对象
        End Function
        ''' <summary>
        ''' 为下拉菜单添加子菜单
        ''' </summary>
        ''' <param name="parentMenu">下拉菜单</param>
        ''' <param name="index">子菜单的位置</param>
        ''' <param name="name">子菜单的显示名称</param>
        ''' <param name="tag">子菜单的标识字符串</param>
        ''' <returns>返回添加的子菜单</returns>
        <Extension()>
        Function AddSubMenu(ByVal parentMenu As PopMenu, ByVal index As Integer, ByVal name As String, ByVal tag As String) As PopMenu
            Dim pm As PopMenu = Nothing ''声明子菜单对象（属于下拉菜单类）
            ''如果菜单组中没有名称为name的下拉菜单
            If parentMenu.CustomizationSection.MenuGroup.PopMenus.IsNameFree(name) Then
                ''为子菜单指定显示名称、标识符和所属的菜单组，别名设为null
                pm = New PopMenu(name, Nothing, tag, parentMenu.CustomizationSection.MenuGroup)
                ''为子菜单指定其所属的菜单
                Dim menuRef As PopMenuRef = New PopMenuRef(pm, parentMenu, index)
            End If

            Return pm ''返回子菜单对象
        End Function
        ''' <summary>
        ''' 为菜单添加分隔条
        ''' </summary>
        ''' <param name="parentMenu">下拉菜单</param>
        ''' <param name="index">分隔条的位置</param>
        ''' <returns>返回添加的分隔条</returns>
        <Extension()>
        Function AddSeparator(ByVal parentMenu As PopMenu, ByVal index As Integer) As PopMenuItem
            ''定义一个分隔条并返回
            Return New PopMenuItem(parentMenu, index)
        End Function
        ''' <summary>
        ''' 添加工具栏
        ''' </summary>
        ''' <param name="menuGroup">工具栏所属的菜单组</param>
        ''' <param name="name">工具栏的显示名称</param>
        ''' <returns>返回添加的工具栏</returns>
        <Extension()>
        Function AddToolbar(ByVal menuGroup As MenuGroup, ByVal name As String) As Toolbar
            Dim tb As Toolbar = Nothing ''声明一个工具栏对象
            ''如果菜单组中没有名称为name的工具栏
            If menuGroup.Toolbars.IsNameFree(name) Then
                ''为工具栏指定显示名称和所属的菜单组
                tb = New Toolbar(name, menuGroup)
                ''设置工具栏为浮动工具栏
                tb.ToolbarOrient = ToolbarOrient.floating
                ''设置工具栏可见
                tb.ToolbarVisible = ToolbarVisible.show
            End If

            Return tb ''返回工具栏对象
        End Function
        ''' <summary>
        ''' 向工具栏添加按钮
        ''' </summary>
        ''' <param name="parent">按钮所属的工具栏</param>
        ''' <param name="index">按钮在工具栏上的位置</param>
        ''' <param name="name">按钮的显示名称</param>
        ''' <param name="macroId">按钮的命令宏的Id</param>
        ''' <returns>返回工具栏按钮对象</returns>
        <Extension()>
        Function AddToolbarButton(ByVal parent As Toolbar, ByVal index As Integer, ByVal name As String, ByVal macroId As String) As ToolbarButton
            ''创建一个工具栏按钮对象，指定其命令宏Id、显示名称、所属的工具栏和位置
            Dim button As ToolbarButton = New ToolbarButton(macroId, name, parent, index)
            Return button ''返回工具栏按钮对象
        End Function
        ''' <summary>
        ''' 向工具栏添加弹出式工具栏
        ''' </summary>
        ''' <param name="parent">工具栏所属的父工具栏</param>
        ''' <param name="index">弹出式工具栏在父工具栏上的位置</param>
        ''' <param name="toolbarRef">弹出式工具栏所引用的工具栏</param>
        <Extension()>
        Sub AttachToolbarToFlyout(ByVal parent As Toolbar, ByVal index As Integer, ByVal toolbarRef As Toolbar)
            ''创建一个弹出式工具栏，指定其所属的工具栏和位置
            Dim flyout As ToolbarFlyout = New ToolbarFlyout(parent, index)
            ''指定弹出式工具栏所引用的工具栏
            flyout.ToolbarReference = toolbarRef.Name
            ''引用的工具栏初始状态不可见
            toolbarRef.ToolbarVisible = ToolbarVisible.hide
        End Sub
    End Module
End Namespace