CAD2020对应的.net框架为4.7，开发工具为VS2013

下载安装.net4.7

按照参考文献1，安装和配置环境，试验第一个实例。

开始步入正题了。

为了方便开发，最好下载ObjectARX_for_AutoCAD_2020_Win_64_bit，只用到里面的帮助文档。

自定义菜单，增加引用AcCui.dll

参考参考文献，新建一个自定义菜单文件，custom.cuix

新建类

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 odpmMagProcess.DotNetARX Imports Autodesk.AutoCAD.Windows

Namespace CUIExample     Public Class CUIExample         Private ReadOnly cuiFile As String = "D:\testVBNet\ODPM\custom.cuix"         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.Command("cuiunload " & menuGroupName & " ")             Application.SetSystemVariable("FILEDIA", oldFileDia)         End Sub

                Public Sub AddMenu()             Dim currentPath As String = "D:\testVBNet\ODPM"             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

                Public Sub AddToolbar()             Dim currentPath As String = "D:\testVBNet\ODPM"             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

                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

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

                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

                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

                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     '''     ''' 操作CUI的类     '''     Module CUITools         '''         ''' 获取并打开主CUI文件         '''         ''' AutoCAD文档对象         ''' 返回主CUI文件                 Function GetMainCustomizationSection(ByVal doc As Document) As CustomizationSection             ''获得主CUI文件所在的位置             Dim mainCuiFile As String = Application.GetSystemVariable("MENUNAME") & ".cui"             mainCuiFile = "C:\Program Files\Autodesk\AutoCAD 2020\UserDataCache\zh-cn\Support\acad.CUIX"             Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor             ed.WriteMessage(mainCuiFile)             ''打开主CUI文件             Return New CustomizationSection(mainCuiFile)         End Function         '''         ''' 创建局部CUI文件         '''         ''' AutoCAD文档对象         ''' CUI文件名         ''' 菜单组的名称         ''' 返回创建的CUI文件                 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         '''         ''' 装载指定的局部CUI文件         '''         ''' CUI文件                 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         '''         ''' 添加菜单项所要执行的宏         '''         ''' CUI文件         ''' 宏的显示名称         ''' 宏的具体命令         ''' 宏的标识符         ''' 宏的状态栏提示信息         ''' 宏的图标         ''' 返回创建的宏                 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         '''         ''' 添加下拉菜单         '''         ''' 包含菜单的菜单组         ''' 菜单名         ''' 菜单的别名         ''' 菜单的标识字符串         ''' 返回下拉菜单对象                 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         '''         ''' 为菜单添加菜单项         '''         ''' 菜单项所属的菜单         ''' 菜单项的位置         ''' 菜单项的显示名称         ''' 菜单项的命令宏的Id         ''' 返回添加的菜单项                 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         '''         ''' 为下拉菜单添加子菜单         '''         ''' 下拉菜单         ''' 子菜单的位置         ''' 子菜单的显示名称         ''' 子菜单的标识字符串         ''' 返回添加的子菜单                 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         '''         ''' 为菜单添加分隔条         '''         ''' 下拉菜单         ''' 分隔条的位置         ''' 返回添加的分隔条                 Function AddSeparator(ByVal parentMenu As PopMenu, ByVal index As Integer) As PopMenuItem             ''定义一个分隔条并返回             Return New PopMenuItem(parentMenu, index)         End Function         '''         ''' 添加工具栏         '''         ''' 工具栏所属的菜单组         ''' 工具栏的显示名称         ''' 返回添加的工具栏                 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         '''         ''' 向工具栏添加按钮         '''         ''' 按钮所属的工具栏         ''' 按钮在工具栏上的位置         ''' 按钮的显示名称         ''' 按钮的命令宏的Id         ''' 返回工具栏按钮对象                 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         '''         ''' 向工具栏添加弹出式工具栏         '''         ''' 工具栏所属的父工具栏         ''' 弹出式工具栏在父工具栏上的位置         ''' 弹出式工具栏所引用的工具栏                 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

运行

菜单宏的特别字符。

; 产生ENTER

^M 产生ENTER

^I 产生TAB

SPACEBAR 输入空格；菜单项中命令序列之间的空格等价于按SPACEBAR

暂停以等候用户输入（不能用在快捷键部分）

- 转变AutoCAD命令及其后的要害字

+ 延续菜单宏到下一行（假如是最后一个字符）

=* 显示当前顶层的图像、下拉菜单或快捷菜单

*^C^C 重复项的前缀

$ 加载菜单部分或输入条件DIESEL宏表达式（$M=）的特别字符

^B ^B切换捕获开或关（CTRL+B）

^C 取消命令（ESC）

^D 切换坐标显示开或关（CTRL+D）

^E 设置下一个等轴测平面（CTRL+E）

^G 切换栅格开或关（CTRL+G）

^H 产生退格

^O 切换正交模式开或关（CTRL+O）

^P 切换MENUECHO开或关

^Q 显示所有提示、状态列表和打印输入（CTRL+Q）

标签控制符。

​​​​​​​

-- 下拉菜单或快捷菜单中的菜单项分隔符（使用时，不能包括其它任何字符）

+ 延续宏到下一行（假如是最后一个字符）

-> 指出下拉菜单或快捷菜单具有子菜单