VB.NET [源码] AutoCAD下拉菜单和折叠菜单

pmq · 发表于昨天 14:44

本帖最后由 pmq 于 2025-4-20 14:50 编辑

VB.NET写的 AutoCAD下拉菜单和折叠菜单
可自定义配置文件

编译好的DLL

折叠菜单

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Windows
Imports System.IO
Imports System.Windows.Forms
Public Class CADCollapsibleMenuWithAutoCollapse
' 定义命令和宏的配置类
Public Class CommandConfig
Public Property Title As String ' 菜单标题
Public Property Macro As String ' 对应的AutoCAD宏命令
Public Property IconPath As String ' 图标路径（可选）
Public Property SubCommands As List(Of CommandConfig) ' 子菜单列表
End Class
' PaletteSet 对象（侧边栏菜单）
Private Shared paletteSet As PaletteSet
' 用于记录当前展开的子菜单容器
Private Shared currentExpandedMenu As FlowLayoutPanel
' 主方法：创建折叠式侧边栏菜单
<CommandMethod("ZDCD")>
Public Sub CreateCollapsibleMenuWithTriangles()
' 如果 PaletteSet 已经存在，则直接显示
If paletteSet IsNot Nothing AndAlso paletteSet.Visible Then
paletteSet.Visible = True
Return
End If
' 配置文件路径
Dim filePath As String = "C:\Asur\MenuRes\commandICO.txt"
Dim commands As List(Of CommandConfig) = LoadCommandsFromTextFile(filePath)
If commands Is Nothing OrElse commands.Count = 0 Then
MsgBox("未在配置文件中找到有效命令。")
Exit Sub
End If
' 创建 PaletteSet（可停靠窗口）
paletteSet = New PaletteSet("Collapsible Menu") With {
.Style = PaletteSetStyles.ShowPropertiesMenu Or PaletteSetStyles.ShowAutoHideButton,
.MinimumSize = New Drawing.Size(180, 500) ' 设置最小尺寸
}
' 创建一个主 Panel 容器
Dim mainPanel As New FlowLayoutPanel() With {
.Dock = DockStyle.Fill,
.AutoScroll = True, ' 支持滚动
.FlowDirection = FlowDirection.TopDown, ' 主菜单按钮竖向排列
.Padding = New Padding(0),
.Margin = New Padding(0)
}
' 遍历命令列表，生成主菜单和子菜单
For Each command In commands
' 主菜单按钮
Dim mainButton As New Button() With {
.Text = "▶ " & command.Title,
.Width = 180,
.Height = 25,
.Margin = New Padding(0),
.Padding = New Padding(0),
.BackColor = Drawing.Color.LightGray,
.TextAlign = Drawing.ContentAlignment.MiddleLeft
}
' 子菜单 Panel
Dim subMenuPanel As New FlowLayoutPanel() With {
.Dock = DockStyle.Top,
.AutoSize = True,
.Visible = False, ' 默认隐藏子菜单
.FlowDirection = FlowDirection.TopDown,
.Padding = New Padding(0),
.Margin = New Padding(0)
}
' 添加子菜单按钮
If command.SubCommands IsNot Nothing AndAlso command.SubCommands.Count > 0 Then
For Each subCommand In command.SubCommands
Dim subButton As New Button() With {
.Text = subCommand.Title,
.Width = 180,
.Height = 25,
.Margin = New Padding(0),
.Padding = New Padding(0),
.BackColor = Drawing.Color.White,
.TextAlign = Drawing.ContentAlignment.MiddleLeft
}
' 子菜单按钮点击事件
AddHandler subButton.Click,
Sub(sender, e)
Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.SendStringToExecute(subCommand.Macro & vbCr, True, False, False)
End Sub
subMenuPanel.Controls.Add(subButton)
Next
End If
' 主菜单按钮点击事件
AddHandler mainButton.Click,
Sub(sender, e)
' 收起当前展开的子菜单
If currentExpandedMenu IsNot Nothing AndAlso currentExpandedMenu IsNot subMenuPanel Then
currentExpandedMenu.Visible = False
Dim parentButton = CType(mainPanel.Controls(mainPanel.Controls.IndexOf(currentExpandedMenu) - 1), Button)
parentButton.Text = "▶ " & parentButton.Text.Substring(2)
End If
' 切换当前子菜单的可见性
subMenuPanel.Visible = Not subMenuPanel.Visible
mainButton.Text = If(subMenuPanel.Visible, "▼ " & command.Title, "▶ " & command.Title)
' 更新当前展开的子菜单
If subMenuPanel.Visible Then
currentExpandedMenu = subMenuPanel
Else
currentExpandedMenu = Nothing
End If
End Sub
' 添加主菜单和子菜单到主 Panel
mainPanel.Controls.Add(mainButton)
mainPanel.Controls.Add(subMenuPanel)
Next
' 将主 Panel 添加到 PaletteSet
paletteSet.Add("折叠菜单", mainPanel)
paletteSet.Visible = True
paletteSet.Size = New Drawing.Size(150, 500)
paletteSet.Dock = DockSides.Left
End Sub
' 从文本文件加载命令配置
Private Function LoadCommandsFromTextFile(filePath As String) As List(Of CommandConfig)
Dim commands As New List(Of CommandConfig)
Dim currentParent As CommandConfig = Nothing
Try
If File.Exists(filePath) Then
Dim lines = File.ReadAllLines(filePath)
For Each line In lines
If String.IsNullOrWhiteSpace(line) OrElse line.StartsWith("#") Then Continue For
If line.StartsWith(" ") Then
Dim match = System.Text.RegularExpressions.Regex.Match(line.Trim(), "^\[(.*?)(?:,(.*?))?\](.*?)$")
If match.Success AndAlso currentParent IsNot Nothing Then
currentParent.SubCommands.Add(New CommandConfig() With {
.Title = match.Groups(1).Value.Trim(),
.Macro = match.Groups(3).Value.Trim(),
.IconPath = If(match.Groups(2).Success, match.Groups(2).Value.Trim(), Nothing)
})
End If
Else
Dim match = System.Text.RegularExpressions.Regex.Match(line.Trim(), "^\[(.*)\]$")
If match.Success Then
Dim parentCommand As New CommandConfig() With {
.Title = match.Groups(1).Value.Trim(),
.Macro = String.Empty,
.SubCommands = New List(Of CommandConfig)()
}
commands.Add(parentCommand)
currentParent = parentCommand
End If
End If
Next
Else
MsgBox("未找到配置文件：" & filePath)
End If
Catch ex As Exception
MsgBox("读取配置文件时出错：" & ex.Message)
End Try
Return commands
End Function
End Class

Imports Autodesk.<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>.Runtime 
Imports Autodesk.AutoCAD.Windows 
Imports System.IO 
Imports System.Windows.Forms 
 
Public Class CADCollapsibleMenuWithAutoCollapse 
 
    ' 定义命令和宏的配置类 
    Public Class CommandConfig 
        Public Property Title As String  ' 菜单标题 
        Public Property Macro As String  ' 对应的AutoCAD宏命令 
        Public Property IconPath As String ' 图标路径（可选） 
        Public Property SubCommands As List(Of CommandConfig) ' 子菜单列表 
    End Class 
 
    ' PaletteSet 对象（侧边栏菜单） 
    Private Shared paletteSet As PaletteSet 
 
    ' 用于记录当前展开的子菜单容器 
    Private Shared currentExpandedMenu As FlowLayoutPanel 
 
    ' 主方法：创建折叠式侧边栏菜单 
    <CommandMethod("ZDCD")> 
    Public Sub CreateCollapsibleMenuWithTriangles() 
        ' 如果 PaletteSet 已经存在，则直接显示 
        If paletteSet IsNot Nothing AndAlso paletteSet.Visible Then 
            paletteSet.Visible = True 
            Return 
        End If 
 
        ' 配置文件路径 
        Dim filePath As String = "C:\Asur\MenuRes\commandICO.txt" 
        Dim commands As List(Of CommandConfig) = LoadCommandsFromTextFile(filePath) 
 
        If commands Is Nothing OrElse commands.Count = 0 Then 
            MsgBox("未在配置文件中找到有效命令。") 
            Exit Sub 
        End If 
 
        ' 创建 PaletteSet（可停靠窗口） 
        paletteSet = New PaletteSet("Collapsible Menu") With { 
            .Style = PaletteSetStyles.ShowPropertiesMenu Or PaletteSetStyles.ShowAutoHideButton, 
            .MinimumSize = New Drawing.Size(180, 500) ' 设置最小尺寸 
        } 
 
        ' 创建一个主 Panel 容器 
        Dim mainPanel As New FlowLayoutPanel() With { 
            .Dock = DockStyle.Fill, 
            .AutoScroll = True, ' 支持滚动 
            .FlowDirection = FlowDirection.TopDown, ' 主菜单按钮竖向排列 
            .Padding = New Padding(0), 
            .Margin = New Padding(0) 
        } 
 
        ' 遍历命令列表，生成主菜单和子菜单 
        For Each command In commands 
            ' 主菜单按钮 
            Dim mainButton As New Button() With { 
                .Text = "&#9654; " & command.Title, 
                .Width = 180, 
                .Height = 25, 
                .Margin = New Padding(0), 
                .Padding = New Padding(0), 
                .BackColor = Drawing.Color.LightGray, 
                .TextAlign = Drawing.ContentAlignment.MiddleLeft 
            } 
 
            ' 子菜单 Panel 
            Dim subMenuPanel As New FlowLayoutPanel() With { 
                .Dock = DockStyle.Top, 
                .AutoSize = True, 
                .Visible = False, ' 默认隐藏子菜单 
                .FlowDirection = FlowDirection.TopDown, 
                .Padding = New Padding(0), 
                .Margin = New Padding(0) 
            } 
 
            ' 添加子菜单按钮 
            If command.SubCommands IsNot Nothing AndAlso command.SubCommands.Count > 0 Then 
                For Each subCommand In command.SubCommands 
                    Dim subButton As New Button() With { 
                        .Text = subCommand.Title, 
                        .Width = 180, 
                        .Height = 25, 
                        .Margin = New Padding(0), 
                        .Padding = New Padding(0), 
                        .BackColor = Drawing.Color.White, 
                        .TextAlign = Drawing.ContentAlignment.MiddleLeft 
                    } 
 
                    ' 子菜单按钮点击事件 
                    AddHandler subButton.Click, 
                        Sub(sender, e) 
                            Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.SendStringToExecute(subCommand.Macro & vbCr, True, False, False) 
                        End Sub 
 
                    subMenuPanel.Controls.Add(subButton) 
                Next 
            End If 
 
            ' 主菜单按钮点击事件 
            AddHandler mainButton.Click, 
                Sub(sender, e) 
                    ' 收起当前展开的子菜单 
                    If currentExpandedMenu IsNot Nothing AndAlso currentExpandedMenu IsNot subMenuPanel Then 
                        currentExpandedMenu.Visible = False 
                        Dim parentButton = CType(mainPanel.Controls(mainPanel.Controls.IndexOf(currentExpandedMenu) - 1), Button) 
                        parentButton.Text = "&#9654; " & parentButton.Text.Substring(2) 
                    End If 
 
                    ' 切换当前子菜单的可见性 
                    subMenuPanel.Visible = Not subMenuPanel.Visible 
                    mainButton.Text = If(subMenuPanel.Visible, "▼ " & command.Title, "&#9654; " & command.Title) 
 
                    ' 更新当前展开的子菜单 
                    If subMenuPanel.Visible Then 
                        currentExpandedMenu = subMenuPanel 
                    Else 
                        currentExpandedMenu = Nothing 
                    End If 
                End Sub 
 
            ' 添加主菜单和子菜单到主 Panel 
            mainPanel.Controls.Add(mainButton) 
            mainPanel.Controls.Add(subMenuPanel) 
        Next 
 
        ' 将主 Panel 添加到 PaletteSet 
        paletteSet.Add("折叠菜单", mainPanel) 
        paletteSet.Visible = True 
        paletteSet.Size = New Drawing.Size(150, 500) 
        paletteSet.Dock = DockSides.Left 
    End Sub 
 
    ' 从文本文件加载命令配置 
    Private Function LoadCommandsFromTextFile(filePath As String) As List(Of CommandConfig) 
        Dim commands As New List(Of CommandConfig) 
        Dim currentParent As CommandConfig = Nothing 
 
        Try 
            If File.Exists(filePath) Then 
                Dim lines = File.ReadAllLines(filePath) 
 
                For Each line In lines 
                    If String.IsNullOrWhiteSpace(line) OrElse line.StartsWith("#") Then Continue For 
 
                    If line.StartsWith("    ") Then 
                        Dim match = System.Text.RegularExpressions.Regex.Match(line.Trim(), "^\[(.*?)(?:,(.*?))?\](.*?)$") 
                        If match.Success AndAlso currentParent IsNot Nothing Then 
                            currentParent.SubCommands.Add(New CommandConfig() With { 
                                .Title = match.Groups(1).Value.Trim(), 
                                .Macro = match.Groups(3).Value.Trim(), 
                                .IconPath = If(match.Groups(2).Success, match.Groups(2).Value.Trim(), Nothing) 
                            }) 
                        End If 
                    Else 
                        Dim match = System.Text.RegularExpressions.Regex.Match(line.Trim(), "^\[(.*)\]$") 
                        If match.Success Then 
                            Dim parentCommand As New CommandConfig() With { 
                                .Title = match.Groups(1).Value.Trim(), 
                                .Macro = String.Empty, 
                                .SubCommands = New List(Of CommandConfig)() 
                            } 
                            commands.Add(parentCommand) 
                            currentParent = parentCommand 
                        End If 
                    End If 
                Next 
            Else 
                MsgBox("未找到配置文件：" & filePath) 
            End If 
        Catch ex As Exception 
            MsgBox("读取配置文件时出错：" & ex.Message) 
        End Try 
 
        Return commands 
    End Function 
 
End Class

下拉菜单

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Windows
Imports System.IO
Imports System.Windows.Forms
Imports System.Drawing ' 用于加载图标
Imports System.Text.RegularExpressions
Public Class DynamicToolbarMenu
' 定义命令和宏的配置类
Public Class CommandConfig
Public Property Title As String ' 菜单标题
Public Property Macro As String ' 对应的AutoCAD宏命令
Public Property IconPath As String ' 图标路径
Public Property SubCommands As List(Of CommandConfig) ' 子菜单
End Class
' 主方法：创建嵌套菜单形式的 PaletteSet
<CommandMethod("XLCD")>
Public Sub CreateDynamicToolbarMenu()
Dim filePath As String = "C:\Asur\MenuRes\commandICO.txt"
Dim ed = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim commands As List(Of CommandConfig) = LoadCommandsFromTextFile(filePath)
If commands Is Nothing OrElse commands.Count = 0 Then
MsgBox("未在配置文件中找到有效命令。")
Exit Sub
End If
' 创建 PaletteSet（可停靠窗口）
Dim paletteSet As New PaletteSet("Dynamic Toolbar") With {
.Style = PaletteSetStyles.ShowPropertiesMenu Or PaletteSetStyles.ShowAutoHideButton,
.MinimumSize = New Drawing.Size(400, 50)
}
' 创建一个 Panel 来容纳工具条
Dim panel As New Panel() With {
.Dock = DockStyle.Fill
}
' 创建工具条
Dim toolStrip As New ToolStrip() With {
.Dock = DockStyle.Top
}
' 遍历命令列表，添加到工具条
For Each command In commands
ed.WriteMessage("生成主菜单: " & command.Title & vbCrLf)
Dim dropDownButton As New ToolStripDropDownButton() With {
.Text = command.Title
}
If command.SubCommands IsNot Nothing AndAlso command.SubCommands.Count > 0 Then
For Each subCommand In command.SubCommands
ed.WriteMessage(" 添加子菜单: " & subCommand.Title & vbCrLf)
Dim subButton As New ToolStripMenuItem() With {
.Text = subCommand.Title
}
' 仅在图标路径存在时加载图标
If Not String.IsNullOrEmpty(subCommand.IconPath) Then
Dim icon = LoadIcon(subCommand.IconPath)
If icon IsNot Nothing Then
subButton.Image = icon
End If
End If
AddHandler subButton.Click, Sub(sender, e)
Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.SendStringToExecute(subCommand.Macro & vbCr, True, False, False)
End Sub
dropDownButton.DropDownItems.Add(subButton)
Next
End If
toolStrip.Items.Add(dropDownButton)
Next
' 将工具条添加到 Panel
panel.Controls.Add(toolStrip)
' 将 Panel 添加到 PaletteSet
paletteSet.Add("Toolbar", panel)
paletteSet.Size = New Drawing.Size(400, 25)
paletteSet.Dock = DockSides.Top
paletteSet.Visible = True
End Sub
' 从文本文件加载命令配置，包括主菜单和子菜单
Private Function LoadCommandsFromTextFile(filePath As String) As List(Of CommandConfig)
Dim ed = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim commands As New List(Of CommandConfig)
Dim currentParent As CommandConfig = Nothing
Try
If File.Exists(filePath) Then
Dim lines = File.ReadAllLines(filePath)
ed.WriteMessage("读取配置文件成功，文件路径: " & filePath & vbCrLf)
For Each line In lines
' 跳过空行和注释
If String.IsNullOrWhiteSpace(line) OrElse line.StartsWith("'") Then Continue For
ed.WriteMessage("读取行: " & line & vbCrLf)
' 判断是否是主菜单
If Not line.StartsWith(" ") AndAlso line.StartsWith("[") Then
' 主菜单解析
Dim title = line.Trim().Trim("["c, "]"c)
Dim parentCommand As New CommandConfig() With {
.Title = title,
.Macro = "",
.IconPath = Nothing,
.SubCommands = New List(Of CommandConfig)()
}
ed.WriteMessage("解析主菜单: " & parentCommand.Title & vbCrLf)
commands.Add(parentCommand)
currentParent = parentCommand
ElseIf line.StartsWith(" ") Then
' 子菜单解析
Dim match = Regex.Match(line.Trim(), "^\[(.*?)(?:,(.*?))?\](.*?)$")
If match.Success AndAlso currentParent IsNot Nothing Then
Dim subCommand As New CommandConfig() With {
.Title = match.Groups(1).Value.Trim(), ' 提取标题
.Macro = match.Groups(3).Value.Trim(), ' 提取宏命令
.IconPath = If(match.Groups(2).Success, match.Groups(2).Value.Trim(), Nothing) ' 提取图标路径（如果存在）
}
ed.WriteMessage("解析子菜单: 标题=" & subCommand.Title & ", 宏=" & subCommand.Macro & ", 图标路径=" & If(subCommand.IconPath, "无") & vbCrLf)
currentParent.SubCommands.Add(subCommand)
End If
End If
Next
Else
MsgBox("未找到配置文件：" & filePath)
End If
Catch ex As Exception
MsgBox("读取配置文件时出错：" & ex.Message)
End Try
Return commands
End Function
Private Function LoadIcon(iconPath As String) As Image
Dim ed = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
If Not String.IsNullOrEmpty(iconPath) Then
Dim resolvedPath = Path.Combine("C:\Asur\MenuRes", iconPath)
If File.Exists(resolvedPath) Then
Try
ed.WriteMessage("加载图标: " & resolvedPath & vbCrLf)
Return Image.FromFile(resolvedPath)
Catch ex As Exception
ed.WriteMessage("图标加载失败: " & resolvedPath & " 错误: " & ex.Message & vbCrLf)
End Try
Else
ed.WriteMessage("图标文件不存在: " & resolvedPath & vbCrLf)
End If
Else
ed.WriteMessage("图标路径为空" & vbCrLf)
End If
Return Nothing
End Function
End Class

Imports Autodesk.AutoCAD.Runtime 
Imports Autodesk.AutoCAD.Windows 
Imports System.IO 
Imports System.Windows.Forms 
Imports System.Drawing ' 用于加载图标 
Imports System.Text.RegularExpressions 
 
Public Class DynamicToolbarMenu 
 
    ' 定义命令和宏的配置类 
    Public Class CommandConfig 
        Public Property Title As String ' 菜单标题 
        Public Property Macro As String ' 对应的AutoCAD宏命令 
        Public Property IconPath As String ' 图标路径 
        Public Property SubCommands As List(Of CommandConfig) ' 子菜单 
    End Class 
 
    ' 主方法：创建嵌套菜单形式的 PaletteSet 
    <CommandMethod("XLCD")> 
    Public Sub CreateDynamicToolbarMenu() 
        Dim filePath As String = "C:\Asur\MenuRes\commandICO.txt" 
        Dim ed = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor 
        Dim commands As List(Of CommandConfig) = LoadCommandsFromTextFile(filePath) 
 
        If commands Is Nothing OrElse commands.Count = 0 Then 
            MsgBox("未在配置文件中找到有效命令。") 
            Exit Sub 
        End If 
 
        ' 创建 PaletteSet（可停靠窗口） 
        Dim paletteSet As New PaletteSet("Dynamic Toolbar") With { 
            .Style = PaletteSetStyles.ShowPropertiesMenu Or PaletteSetStyles.ShowAutoHideButton, 
            .MinimumSize = New Drawing.Size(400, 50) 
        } 
 
        ' 创建一个 Panel 来容纳<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a>条 
        Dim panel As New Panel() With { 
            .Dock = DockStyle.Fill 
        } 
 
        ' 创建工具条 
        Dim toolStrip As New ToolStrip() With { 
            .Dock = DockStyle.Top 
        } 
 
        ' 遍历命令列表，添加到工具条 
        For Each command In commands 
            ed.WriteMessage("生成主菜单: " & command.Title & vbCrLf) 
            Dim dropDownButton As New ToolStripDropDownButton() With { 
                .Text = command.Title 
            } 
 
            If command.SubCommands IsNot Nothing AndAlso command.SubCommands.Count > 0 Then 
                For Each subCommand In command.SubCommands 
                    ed.WriteMessage("  添加子菜单: " & subCommand.Title & vbCrLf) 
                    Dim subButton As New ToolStripMenuItem() With { 
                        .Text = subCommand.Title 
                    } 
 
                    ' 仅在图标路径存在时加载图标 
                    If Not String.IsNullOrEmpty(subCommand.IconPath) Then 
                        Dim icon = LoadIcon(subCommand.IconPath) 
                        If icon IsNot Nothing Then 
                            subButton.Image = icon 
                        End If 
                    End If 
 
                    AddHandler subButton.Click, Sub(sender, e) 
                                                    Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.SendStringToExecute(subCommand.Macro & vbCr, True, False, False) 
                                                End Sub 
                    dropDownButton.DropDownItems.Add(subButton) 
                Next 
            End If 
 
            toolStrip.Items.Add(dropDownButton) 
        Next 
 
        ' 将工具条添加到 Panel 
        panel.Controls.Add(toolStrip) 
 
        ' 将 Panel 添加到 PaletteSet 
        paletteSet.Add("Toolbar", panel) 
        paletteSet.Size = New Drawing.Size(400, 25) 
        paletteSet.Dock = DockSides.Top 
        paletteSet.Visible = True 
    End Sub 
 
    ' 从文本文件加载命令配置，包括主菜单和子菜单 
    Private Function LoadCommandsFromTextFile(filePath As String) As List(Of CommandConfig) 
        Dim ed = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor 
        Dim commands As New List(Of CommandConfig) 
        Dim currentParent As CommandConfig = Nothing 
 
        Try 
            If File.Exists(filePath) Then 
                Dim lines = File.ReadAllLines(filePath) 
                ed.WriteMessage("读取配置文件成功，文件路径: " & filePath & vbCrLf) 
 
                For Each line In lines 
                    ' 跳过空行和注释 
                    If String.IsNullOrWhiteSpace(line) OrElse line.StartsWith("'") Then Continue For 
                    ed.WriteMessage("读取行: " & line & vbCrLf) 
 
                    ' 判断是否是主菜单 
                    If Not line.StartsWith("    ") AndAlso line.StartsWith("[") Then 
                        ' 主菜单解析 
                        Dim title = line.Trim().Trim("["c, "]"c) 
                        Dim parentCommand As New CommandConfig() With { 
                            .Title = title, 
                            .Macro = "", 
                            .IconPath = Nothing, 
                            .SubCommands = New List(Of CommandConfig)() 
                        } 
                        ed.WriteMessage("解析主菜单: " & parentCommand.Title & vbCrLf) 
                        commands.Add(parentCommand) 
                        currentParent = parentCommand 
                    ElseIf line.StartsWith("    ") Then 
                        ' 子菜单解析 
                        Dim match = Regex.Match(line.Trim(), "^\[(.*?)(?:,(.*?))?\](.*?)$") 
                        If match.Success AndAlso currentParent IsNot Nothing Then 
                            Dim subCommand As New CommandConfig() With { 
                                .Title = match.Groups(1).Value.Trim(), ' 提取标题 
                                .Macro = match.Groups(3).Value.Trim(), ' 提取宏命令 
                                .IconPath = If(match.Groups(2).Success, match.Groups(2).Value.Trim(), Nothing) ' 提取图标路径（如果存在） 
                            } 
                            ed.WriteMessage("解析子菜单: 标题=" & subCommand.Title & ", 宏=" & subCommand.Macro & ", 图标路径=" & If(subCommand.IconPath, "无") & vbCrLf) 
                            currentParent.SubCommands.Add(subCommand) 
                        End If 
                    End If 
                Next 
            Else 
                MsgBox("未找到配置文件：" & filePath) 
            End If 
        Catch ex As Exception 
            MsgBox("读取配置文件时出错：" & ex.Message) 
        End Try 
 
        Return commands 
    End Function 
 
    Private Function LoadIcon(iconPath As String) As Image 
        Dim ed = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor 
        If Not String.IsNullOrEmpty(iconPath) Then 
            Dim resolvedPath = Path.Combine("C:\Asur\MenuRes", iconPath) 
            If File.Exists(resolvedPath) Then 
                Try 
                    ed.WriteMessage("加载图标: " & resolvedPath & vbCrLf) 
                    Return Image.FromFile(resolvedPath) 
                Catch ex As Exception 
                    ed.WriteMessage("图标加载失败: " & resolvedPath & " 错误: " & ex.Message & vbCrLf) 
                End Try 
            Else 
                ed.WriteMessage("图标文件不存在: " & resolvedPath & vbCrLf) 
            End If 
        Else 
            ed.WriteMessage("图标路径为空" & vbCrLf) 
        End If 
        Return Nothing 
    End Function 
 
End Class

配置文件格式：

[剖面]
[绘制图框,P38tk.bmp]_TK
[绘剖面线,P39pmx.bmp]_Hhatch
[剖面计算,P40js.bmp]_PmJs
[剖面绘制]_HuiPMT
[面积计算,P40js.bmp]_MjJs
[计算体积]_jsTj
[方量计算,P41CLin.bmp]_jsFl
[横剖面计算]_flph
[数据传输]_CeData
[坐标修改]_XYxg
[坐标排序]_Js6
[高程检查]_GcJc
[剖面处理]_Pmcj
[多段线剖面]_flph
[三维线转剖面]_flph
[交点计算,P68djs.BMP]_JDJS
[交点坐标,p69xyh.BMP]_XYZ
[绘制交点]_XZZ
[高程Ｚ轴归零]_GZreo
[剖面分离还原]_Pmfl
[提取剖面数据]_PmSj
[恢复高程注记,P71ZJGC.bmp]
[坐标转剖面]
[创边界,P70cbj.BMP]_Cbj
[生成三维坐标,pspmx.BMP]_XYHtq
***POP5
[绘制]
[展碎部点,P37Pzan.bmp]_ZD
[绘控制点]_ZKzd
[展高程点]_ZGCD
[线的中点]_PX
[绘延长点]_PY
[绘偏移点]_PP
[绘垂直点]_PV
[两点中点]_PZ
[绘铁路]_Rail
[三点房屋]_HFW
[自动编号]_AutoBH
[简码识别]_JMSB
[测屏坐标输点]_Surs
[点到直线距离]
[展Cass高程点]_Cass

复制代码

fxlt619 · 发表于昨天 14:58

只支持cad2026？有其他的吗

pmq · 发表于昨天 16:34

fxlt619 发表于 2025-4-20 14:58
只支持cad2026？有其他的吗

ACeL2026.DLL文件支持CAD2021-2026
源码自己编译成其它版本。
只是引用对应的CAD的三个运行库
accoremgd、acdbmgd、acmgd

liuyj · 发表于昨天 16:43

效果不错，不过为什么出来的是乱码呢？

pmq · 发表于昨天 18:58

liuyj 发表于 2025-4-20 16:43
效果不错，不过为什么出来的是乱码呢？

配置文件可能是以 GBK 或 GB2312（常见于中文环境）编码保存的，而代码默认使用 UTF-8 读取文件

szhorse · 发表于昨天 19:16

感谢分享，侧边菜单栏现在是百花齐放了

zilong136 · 发表于 7 小时前

怎么自定义配置文件？加载你提供的配置打不开二级菜单

pmq · 发表于 5 小时前

本帖最后由 pmq 于 2025-4-21 12:36 编辑

zilong136 发表于 2025-4-21 10:35
怎么自定义配置文件？加载你提供的配置打不开二级菜单

这是一个完整的插件，实用于AutoCAD2021-2026
配置文件在C:\Asur\MenuRes\commandICO.txt
默认二级菜单 [ 前有5个空格
你这个全部是一级菜单，没有二级菜单
最好是解压到C:根目录

lxl217114 · 发表于 2 小时前

点赞点赞
卷起来了，各种边栏产品，百花齐放了。

zijie87 · 发表于 1 小时前

这个可以111111

账号		自动登录	找回密码
密码			注册

[资源] VB.NET [源码] AutoCAD下拉菜单和折叠菜单

本帖子中包含更多资源

评分

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

浏览过的版块