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.DatabaServices
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 nder 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^CEra ", "ID_MyEra", "从图形删除对象: ERASE", currentPath & "\Image\Era.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_MyEra")
menuModify.AddMenuItem(-1, "移动", "ID_MyMove")
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^CEra ", "ID_MyEra", "从图形删除对象: ERASE", currentPath & "\Image\Era.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 buttonEra As ToolbarButton = barModify.AddToolbarButton(-1, "删除", "ID_MyEra")
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 nder As Object, ByVal e As EventArgs)
Dim mi As MenuItem = TryCast(nder, MenuItem)
Dim mi As MenuItem = TryCast(nder, MenuItem)
If mi.Text = "复制" Then
activeDoc.SendStringToExecute("_Copy ", True, Fal, True)
ElIf mi.Text = "删除" Then
activeDoc.SendStringToExecute("_Era ", True, Fal, True)
qq好友恢复网站
End If
End Sub
Private Sub miCircle_Click(ByVal nder As Object, ByVal e As EventArgs)
activeDoc.SendStringToExecute("_Count ", True, Fal, Fal)
End Sub
<CommandMethod("AddObjectContextMenu")>
Public Sub AddObjectContextMenu()
Dim contextMenu As ContextMenuExtension = New ContextMenuExtension()
Dim miCircle As MenuItem = New MenuItem("统计个数")
'miCircle.Click += Sub(ByVal nder As Object, ByVal e As EventArgs)
' activeDoc.SendStringToExecute("_Count ", True, Fal, Fal)
' 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.UPickSet)>
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 Chine\UrDataCache\Sup
port\acad.CUIX" Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
ed.WriteMessage(mainCuiFile)
''打开主CUI⽂件
Return New CustomizationSection(mainCuiFile)
罗贯中的作品
End Function
''' <summary>
''' <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⽂件
El
''如果已经存在指定的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.CUIFileBaName & " ", Fal, Fal, Fal)
''装载CUI⽂件，注意⽂件名必须是带路径的
doc.SendStringToExecute("_.cuiload " & cs.CUIFileName & " ", Fal, Fal, Fal)
''恢复CMDECHO及FILEDIA系统变量的初始值
doc.SendStringToExecute("(tvar ""FILEDIA"" " & oldFileDia.ToString() & ")(princ) ", Fal, Fal, Fal)
doc.SendStringToExecute("(tvar ""CMDECHO"" " & oldCmdEcho.ToString() & ")(princ) ", Fal, Fal, Fal)
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 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的下拉菜单
