AutoCAD图标提取

admin1

1. Imports Autodesk.<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>.ApplicationServices
   
2. Imports Autodesk.AutoCAD.Customization
   
3. Imports Autodesk.AutoCAD.Runtime
   
4. 
   
5. Public Class Class1
   
6. 
   
7. CommandMethod("Test")> _
   
8.     Public Sub Test()
   
9.         ' 16×16图标路径
   
10.         If IO.Directory.Exists(My.Application.Info.DirectoryPath + "\16") = False Then
    
11.             IO.Directory.CreateDirectory(My.Application.Info.DirectoryPath + "\16")
    
12.         End If
    
13.         ' 32×32图标路径
    
14.         If IO.Directory.Exists(My.Application.Info.DirectoryPath + "\32") = False Then
    
15.             IO.Directory.CreateDirectory(My.Application.Info.DirectoryPath + "\32")
    
16.         End If</font></font>
    
17.        ' 通过系统变量获得菜单文件名称
    
18.         Dim s As String = Application.GetSystemVariable("MENUNAME")
    
19.         ' 获得该菜单文件的自定义节
    
20.         Dim cs As CustomizationSection = New CustomizationSection(s)
    
21.         ' 获得菜单组
    
22.         Dim mg As MenuGroup = cs.MenuGroup
    
23.         ' 遍历宏组
    
24.         For i As Integer = 0 To mg.MacroGroups.Count - 1
    
25.             ProcessMacroGroup(mg.MacroGroups(i))
    
26.         Next
    
27.     End Sub
    
28. 
    
29.     'Public Sub ProcessMacroGroup(ByVal mg As MacroGroup)
    
30.     '    ' 遍历菜单宏
    
31.     '    For i As Integer = 0 To mg.MenuMacros.Count - 1
    
32.     '        Dim mm As MenuMacro = mg.MenuMacros(i)
    
33.     '        ' 获得宏
    
34.     '        Dim m As Macro = mm.macro
    
35.     '        ' 判断大图像是否存在
    
36.     '        If m.LargeImageBitmap IsNot Nothing Then
    
37.     '            ' 判断大图像是否正确，如果包含16说明大图像是采用小图像
    
38.     '            If m.LargeImage.Contains("32") = True Then
    
39.     '                m.LargeImageBitmap.Save(My.Application.Info.DirectoryPath + "\32" + m.LargeImage + ".png", System.Drawing.Imaging.ImageFormat.Png)
    
40.     '            End If
    
41.     '        End If
    
42.     '        ' 判断小图像是否存在
    
43.     '        If m.SmallImageBitmap IsNot Nothing Then
    
44.     '            ' 判断小图像是否正确，如果包含32说明小图像是采用大图像
    
45.     '            If m.SmallImage.Contains("16") = True Then
    
46.     '                m.SmallImageBitmap.Save(My.Application.Info.DirectoryPath + "\16" + m.SmallImage + ".png", System.Drawing.Imaging.ImageFormat.Png)
    
47.     '            End If
    
48.     '        End If
    
49.     '    Next
    
50.     'End Sub
    
51. 
    
52.     Public Sub ProcessMacroGroup(ByVal mg As MacroGroup)
    
53.         ' 遍历菜单宏
    
54.         For i As Integer = 0 To mg.MenuMacros.Count - 1
    
55.             Dim mm As MenuMacro = mg.MenuMacros(i)
    
56.             ' 获得宏
    
57.             Dim m As Macro = mm.macro
    
58.             ' 判断大图像是否存在
    
59.             If m.LargeImageBitmap IsNot Nothing Then
    
60.                 ' 判断大图像是否正确，如果尺寸包含16说明大图像是采用小图像
    
61.                 If m.LargeImageBitmap.Width = 32 And m.LargeImageBitmap.Height = 32 Then
    
62.                     ' 判断图像是否文件名称，如果是复制到内存再保存
    
63.                     If m.LargeImage.Contains(".bmp") = True Then
    
64.                         Dim ti As System.Drawing.Image = New System.Drawing.Bitmap(m.LargeImageBitmap)
    
65.                         ti.Save(My.Application.Info.DirectoryPath + "\32" + m.LargeImage, System.Drawing.Imaging.ImageFormat.Bmp)
    
66.                         ti.Dispose()
    
67.                     Else
    
68.                         m.LargeImageBitmap.Save(My.Application.Info.DirectoryPath + "\32" + m.LargeImage + ".png", System.Drawing.Imaging.ImageFormat.Png)
    
69.                     End If
    
70.                 End If
    
71.             End If
    
72.             ' 判断小图像是否存在
    
73.             If m.SmallImageBitmap IsNot Nothing Then
    
74.                 ' 判断小图像是否正确，如果尺寸包含32说明小图像是采用大图像
    
75.                 If m.SmallImageBitmap.Width = 16 And m.SmallImageBitmap.Height = 16 Then
    
76.                     ' 判断图像是否文件名称，如果是复制到内存再保存
    
77.                     If m.LargeImage.Contains(".bmp") = True Then
    
78.                         Dim ti As System.Drawing.Image = New System.Drawing.Bitmap(m.SmallImageBitmap)
    
79.                         ti.Save(My.Application.Info.DirectoryPath + "\16" + m.SmallImage, System.Drawing.Imaging.ImageFormat.Bmp)
    
80.                         ti.Dispose()
    
81.                     Else
    
82.                         m.SmallImageBitmap.Save(My.Application.Info.DirectoryPath + "\16" + m.SmallImage + ".png", System.Drawing.Imaging.ImageFormat.Png)
    
83.                     End If
    
84.                 End If
    
85.             End If
    
86.         Next
    
87.     End Sub
    
88. 
    
89. End Class

复制代码