AutoCAD图标提取

Imports Autodesk..ApplicationServices
Imports Autodesk.AutoCAD.Customization
Imports Autodesk.AutoCAD.Runtime
Public Class Class1
CommandMethod("Test")> _
    Public Sub Test()
        ' 16×16图标路径
        If IO.Directory.Exists(My.Application.Info.DirectoryPath + "\16") = False Then
            IO.Directory.CreateDirectory(My.Application.Info.DirectoryPath + "\16")
        End If
        ' 32×32图标路径
        If IO.Directory.Exists(My.Application.Info.DirectoryPath + "\32") = False Then
            IO.Directory.CreateDirectory(My.Application.Info.DirectoryPath + "\32")
        End If
       ' 通过系统变量获得菜单文件名称
        Dim s As String = Application.GetSystemVariable("MENUNAME")
        ' 获得该菜单文件的自定义节
        Dim cs As CustomizationSection = New CustomizationSection(s)
        ' 获得菜单组
        Dim mg As MenuGroup = cs.MenuGroup
        ' 遍历宏组
        For i As Integer = 0 To mg.MacroGroups.Count - 1
            ProcessMacroGroup(mg.MacroGroups(i))
        Next
    End Sub
    'Public Sub ProcessMacroGroup(ByVal mg As MacroGroup)
    '    ' 遍历菜单宏
    '    For i As Integer = 0 To mg.MenuMacros.Count - 1
    '        Dim mm As MenuMacro = mg.MenuMacros(i)
    '        ' 获得宏
    '        Dim m As Macro = mm.macro
    '        ' 判断大图像是否存在
    '        If m.LargeImageBitmap IsNot Nothing Then
    '            ' 判断大图像是否正确，如果包含16说明大图像是采用小图像
    '            If m.LargeImage.Contains("32") = True Then
    '                m.LargeImageBitmap.Save(My.Application.Info.DirectoryPath + "\32" + m.LargeImage + ".png", System.Drawing.Imaging.ImageFormat.Png)
    '            End If
    '        End If
    '        ' 判断小图像是否存在
    '        If m.SmallImageBitmap IsNot Nothing Then
    '            ' 判断小图像是否正确，如果包含32说明小图像是采用大图像
    '            If m.SmallImage.Contains("16") = True Then
    '                m.SmallImageBitmap.Save(My.Application.Info.DirectoryPath + "\16" + m.SmallImage + ".png", System.Drawing.Imaging.ImageFormat.Png)
    '            End If
    '        End If
    '    Next
    'End Sub
    Public Sub ProcessMacroGroup(ByVal mg As MacroGroup)
        ' 遍历菜单宏
        For i As Integer = 0 To mg.MenuMacros.Count - 1
            Dim mm As MenuMacro = mg.MenuMacros(i)
            ' 获得宏
            Dim m As Macro = mm.macro
            ' 判断大图像是否存在
            If m.LargeImageBitmap IsNot Nothing Then
                ' 判断大图像是否正确，如果尺寸包含16说明大图像是采用小图像
                If m.LargeImageBitmap.Width = 32 And m.LargeImageBitmap.Height = 32 Then
                    ' 判断图像是否文件名称，如果是复制到内存再保存
                    If m.LargeImage.Contains(".bmp") = True Then
                        Dim ti As System.Drawing.Image = New System.Drawing.Bitmap(m.LargeImageBitmap)
                        ti.Save(My.Application.Info.DirectoryPath + "\32" + m.LargeImage, System.Drawing.Imaging.ImageFormat.Bmp)
                        ti.Dispose()
                    Else
                        m.LargeImageBitmap.Save(My.Application.Info.DirectoryPath + "\32" + m.LargeImage + ".png", System.Drawing.Imaging.ImageFormat.Png)
                    End If
                End If
            End If
            ' 判断小图像是否存在
            If m.SmallImageBitmap IsNot Nothing Then
                ' 判断小图像是否正确，如果尺寸包含32说明小图像是采用大图像
                If m.SmallImageBitmap.Width = 16 And m.SmallImageBitmap.Height = 16 Then
                    ' 判断图像是否文件名称，如果是复制到内存再保存
                    If m.LargeImage.Contains(".bmp") = True Then
                        Dim ti As System.Drawing.Image = New System.Drawing.Bitmap(m.SmallImageBitmap)
                        ti.Save(My.Application.Info.DirectoryPath + "\16" + m.SmallImage, System.Drawing.Imaging.ImageFormat.Bmp)
                        ti.Dispose()
                    Else
                        m.SmallImageBitmap.Save(My.Application.Info.DirectoryPath + "\16" + m.SmallImage + ".png", System.Drawing.Imaging.ImageFormat.Png)
                    End If
                End If
            End If
        Next
    End Sub
End Class

srsmti0i3az.png