admin1 发表于 2024-3-31 10:23:12

AutoCAD图标提取

Imports Autodesk.<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>.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</font></font>
       ' 通过系统变量获得菜单文件名称
      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
页: [1]
查看完整版本: AutoCAD图标提取