AddReference "stdole" AddReference "System.Drawing" AddReference "System.Runtime" AddReference "System.Runtime.InteropServices" Imports System.Drawing Imports System.Drawing.Imaging Imports System.Runtime.InteropServices Imports stdole Sub Main Dim oInvApp As Inventor.Application = ThisApplication Dim oCDs As ControlDefinitions = oInvApp.CommandManager.ControlDefinitions Dim oCmdNames As New List(Of String) For Each oCD As ControlDefinition In oCDs If Not oCD.BuiltIn Then Continue For Try If (TypeOf oCD Is Inventor.ButtonDefinition) OrElse (TypeOf oCD Is Inventor.ButtonDefinitionClass) Then oCmdNames.Add(oCD.InternalName) End If Catch End Try Next oCD Dim sChosenCmdName As String = Nothing sChosenCmdName = InputListBox("Choose Command To Save Its Icons To File.", oCmdNames, "", "Command DisplayNames") If sChosenCmdName Is Nothing OrElse sChosenCmdName = "" Then Return Dim oChosenCmd As ButtonDefinition = TryCast(oCDs.Item(sChosenCmdName), Inventor.ButtonDefinition) If oChosenCmd Is Nothing Then Return Dim oLargeIPD As stdole.IPictureDisp = Nothing Try : oLargeIPD = oChosenCmd.LargeIcon : Catch : End Try Dim oStandardIPD As stdole.IPictureDisp = Nothing Try : oStandardIPD = oChosenCmd.StandardIcon : Catch : End Try If ((oLargeIPD Is Nothing) AndAlso (oStandardIPD Is Nothing)) Then Return Dim oLargeIcon As System.Drawing.Icon = PictureDispToIcon(oLargeIPD, True) Dim oStandardIcon As System.Drawing.Icon = PictureDispToIcon(oStandardIPD, False) If ((oLargeIcon Is Nothing) AndAlso (oStandardIcon Is Nothing)) Then Return Dim oIcons As New List(Of KeyValuePair(Of String, System.Drawing.Icon)) oIcons.Add(New KeyValuePair(Of String, System.Drawing.Icon)("large", oLargeIcon)) oIcons.Add(New KeyValuePair(Of String, System.Drawing.Icon)("small", oStandardIcon)) Dim sPath As String = "C:\Temp\Inventor Command Icons\" If Not System.IO.Directory.Exists(sPath) Then Try : System.IO.Directory.CreateDirectory(sPath) Catch : Return : End Try End If Dim sActiveTheme As String = ThisApplication.ThemeManager.ActiveTheme.Name.ToLower.Replace("theme", "") For Each oEntry As KeyValuePair(Of String, System.Drawing.Icon) In oIcons Dim oIcon As System.Drawing.Icon = oEntry.Value If oIcon Is Nothing Then Continue For Dim sSize As String = oEntry.Key Dim sNewFile As String = sPath & sChosenCmdName & "." & sActiveTheme & "." & sSize & ".png" Try oIcon.ToBitmap().Save(sNewFile, System.Drawing.Imaging.ImageFormat.Png) Logger.Info(vbCrLf & "Saved " & sSize & " icon for Inventor ButtonDefinition named '" & sChosenCmdName & "' to following image file:" _ & vbCrLf & sNewFile & vbCrLf) Catch Logger.Debug(vbCrLf & "Failed to save " & sSize & " icon for Inventor ButtonDefinition named '" & sChosenCmdName & "' to image file!" & vbCrLf) End Try Next oEntry End Sub Function PictureDispToIcon(pictureDisp As stdole.IPictureDisp, bLargeIcon As Boolean) As System.Drawing.Icon If pictureDisp Is Nothing OrElse pictureDisp.Type <> 3 Then Return Nothing Dim oIcon As System.Drawing.Icon oIcon = oIcon.FromHandle(New IntPtr(pictureDisp.Handle)) If bLargeIcon Then oIcon = New Icon(oIcon, 32, 32) Else oIcon = New Icon(oIcon, 16, 16) End If Return oIcon End Function