Save Thumbnail vba macro to iLogic

[Anonymous]

I'm trying to adapt the code below to an iLogic rule taken from VBA macro

Sub Main SaveThumbnail()
    ' Get the active document.
    Dim doc As Document
    doc = ThisApplication.ActiveDocument

    ' Get the thumbnail from the document.
    Dim thumb As IPictureDisp
    thumb = doc.Thumbnail

    ' Create the filename for the bmp file so it is the same
    ' as the document name but with a "bmp" extension.
    Dim filename As String
    filename = Left$(doc.FullFileName, Len(doc.FullFileName) - 3) & "bmp"

    ' Save the thumbnail.
    Call SavePicture(thumb, filename)
End Sub

 I get errors saying:

Error on Line 8 : Reference required to assembly 'stdole, Version=7.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a' containing the type 'stdole.IPictureDisp'. Add one to your project.
Error on Line 16 : 'SavePicture' is not declared. It may be inaccessible due to its protection level.

Can anyone advise how to fix please?

[MechMachineMan]

Above it....

AddReference "stdole.dll"

[Anonymous]

hey @MechMachineMan

thanks, that took care of the first error. I'm still getting 'SavePicture is not declared'

Do I need to proceed it with something?

[Sergio.D.Suárez]

hello this is a rule that exports the list of materials to excel with a template and with thumbnails, generates the thumbnails of each reference file and then adds them as a comment, to achieve increasing the size of the view to taste without increasing the size from the list of materials. Care should be taken as to how values and file paths are entered.

If the Inv language is in English it should correct "structured" and "parts only"

I hope you understand greetings

Sub Main() 
On Error Resume Next 

Dim Dirtemp As String = "C:\Users\Sergio\AppData\Local\Temp\"     '''Especifique la ruta de la carpeta temporal
Dim Dirxlsx As String = "E:\Libro1.xlsx"                          ''' Especifique la ruta de la plantilla
Dim osheetbom As String = "BOM"                                   ''' Especifique la hoja de la plantilla

Dim oDoc As AssemblyDocument
oDoc = ThisApplication.ActiveDocument
Dim oBOM As BOM
oBOM = oDoc.ComponentDefinition.BOM
    ' Set the structured view to 'all levels'
oBOM.StructuredViewFirstLevelOnly = False
    ' Make sure that the structured view is enabled.
oBOM.StructuredViewEnabled = True
    ' Make sure that the parts only view is enabled.
oBOM.PartsOnlyViewEnabled = True
    ' Establece el tipo de lista de materiales, estructurado o solo partes
	
Dim oValueList As New ArrayList
oValueList.Add("Estructurado") ''' Si el idioma de Inv esta en ingles corregir a "Structured"
oValueList.Add("Solo Piezas") ''' Si el idioma de Inv esta en ingles corregir a "Parts Only"
Dim oValue As String
	oValue = InputListBox("Selecciona el tipo de Lista a exportar", oValueList, "Estructurado", "iLogic", "Selecciones Disponibles")
	
Dim oBOMView As BOMView
oBOMView = oBOM.BOMViews.Item(oValue)
Dim orden As String = InputBox("Ordenar por", "Exportar BOM", "Part Number")

oBOMView.Sort(orden, True)' Indicar por medio de que factor se ordenara la lista
oBOMView.Renumber(1, 1)

xlApp = CreateObject("Excel.Application")

xlApp.Visible = True
xlWorkbook = xlApp.Workbooks.Open(Dirxlsx)

xlWorksheet = xlWorkbook.Worksheets.Item(osheetbom)
Dim row As Integer
row = 3                 ''' Indicar a partir de que fila comenzara el copiado a excel

'Dim bRow As bomRow
bRows = oBOMView.BOMRows
For Each bRow In bRows

Dim rDoc As Inventor.Document'Document
rDoc = bRow.ComponentDefinitions.Item(1).Document

Dim rDocName As String = rDoc.DisplayName

Dim m_Camera As Inventor.Camera
m_Camera = ThisServer.TransientObjects.CreateCamera()
If rDoc.DocumentType = kPartDocumentObject Then
  m_Camera.SceneObject = DirectCast(rDoc, PartDocument).ComponentDefinition
Else
  m_Camera.SceneObject = DirectCast(rDoc, AssemblyDocument).ComponentDefinition
End If
m_Camera.Perspective = True

Dim m_TO As Inventor.TransientObjects
m_TO = ThisApplication.TransientObjects

m_Camera.ViewOrientationType = Inventor.ViewOrientationTypeEnum.kIsoTopLeftViewOrientation
m_Camera.Fit
m_Camera.ApplyWithoutTransition
 
ThisApplication.DisplayOptions.NewWindowDisplayMode = DisplayModeEnum.kShadedWithEdgesRendering
ThisApplication.DisplayOptions.Show3DIndicator = False

Dim TumbFilename As String = Dirtemp & rDocName & ".bmp"

m_Camera.SaveAsBitmap(TumbFilename, 800, 600, m_TO.CreateColor(255,255,255))

'Next

Dim docPropertySet As PropertySet
docPropertySet = rDoc.PropertySets.Item("Design Tracking Properties")

'Se seleccionan las columnas de tabla que se exportaran al archivo excel asi como su ubicacion

xlWorksheet.Range("A" & row).Value = bRow.ItemQuantity
xlWorksheet.Range("B" & row).Value = docPropertySet.Item("Part Number").Value
xlWorksheet.Range("C" & row).Value = docPropertySet.Item("Description").Value


With xlWorksheet.Range("B" & row)
            .AddComment
            .Comment.Visible = False
			.Comment.Text(rDocName) 
            .Comment.Shape.Fill.UserPicture(TumbFilename)
            .Comment.Shape.Height = 150
            .Comment.Shape.Width = 150
End With
'xlWorksheet.Range("A" & row).Value = bRow.ItemNumber  
'xlWorksheet.Range("E" & row).Value = docPropertySet.Item("Cost").Value
'xlWorksheet.Range("F" & row).Value = docPropertySet.Item("Stock number").Value
'xlWorksheet.Range("G" & row).Value = docPropertySet.Item("Vendor").Value

row = row + 1
Next

xlWorksheet.Columns("A:Z").AutoFit

Dim oFileName As String = "Export_" &   oDoc.DisplayName & ".xlsx"
MessageBox.Show(oFileName , "Exportando a")
xlWorkBook.SaveAs(ThisDoc.Path & "\" & oFileName)' El archivo de excel se guardara en la ubicacion del archivo de ensamblaje
xlWorkbook.Close (True)
xlApp.Quit
 End Sub

[Reitshammer]

Hello, I tested your code in IV2024. Unfortunately, it doesn't work for me, and I can't see any errors. Can you help me further? Thank you in advance.

Sub Main()
    On Error Resume Next

    Dim Dirtemp As String = "C:\temp\"     '''Geben Sie den Pfad zum temporären Ordner an
    Dim Dirxlsx As String = "C:\Vault\Vorlage.xlsx"                          '''Geben Sie den Pfad zur Vorlage an
    Dim osheetbom As String = "Gesamt"                                   '''Geben Sie das Blatt der Vorlage an

    Dim oDoc As AssemblyDocument
    oDoc = ThisApplication.ActiveDocument
    Dim oBOM As BOM
    oBOM = oDoc.ComponentDefinition.BOM
    ' Setzen Sie die strukturierte Ansicht auf "alle Ebenen"
    oBOM.StructuredViewFirstLevelOnly = False
    ' Stellen Sie sicher, dass die strukturierte Ansicht aktiviert ist.
    oBOM.StructuredViewEnabled = True
    ' Stellen Sie sicher, dass die Ansicht "Nur Teile" aktiviert ist.
    oBOM.PartsOnlyViewEnabled = True
    ' Legen Sie den Typ der Stückliste fest, strukturiert oder nur Teile

    Dim oValueList As New ArrayList
    oValueList.Add("Structured") ''' Wenn die Sprache von Inventor auf Englisch eingestellt ist, ändern Sie dies in "Structured"
    oValueList.Add("Parts Only") ''' Wenn die Sprache von Inventor auf Englisch eingestellt ist, ändern Sie dies in "Parts Only"
    Dim oValue As String
    oValue = InputListBox("Wählen Sie den zu exportierenden Listentyp", oValueList, "Estructurado", "iLogic", "Verfügbare Auswahlmöglichkeiten")

    Dim oBOMView As BOMView
    oBOMView = oBOM.BOMViews.Item(oValue)
    Dim orden As String = InputBox("Sortieren nach", "Stückliste exportieren", "Part Number")

    oBOMView.Sort (orden, True) ' Geben Sie an, nach welchem Faktor die Liste sortiert wird
    oBOMView.Renumber (1, 1)

    Dim xlApp As Object
    xlApp = CreateObject("Excel.Application")

    xlApp.Visible = True
    Dim xlWorkbook As Object
    xlWorkbook = xlApp.Workbooks.Open(Dirxlsx)

    Dim xlWorksheet As Object
    xlWorksheet = xlWorkbook.Worksheets.Item(osheetbom)
    Dim row As Integer
    row = 7                 ''' Geben Sie an, ab welcher Zeile das Kopieren nach Excel beginnt


	

    Dim bRow As BOMRow
	bRow = oBOMView.BOMRows
	For Each bRow In bRows

        Dim rDoc As Inventor.Document 'Dokument
        rDoc = bRow.ComponentDefinitions.Item(1).Document

        Dim rDocName As String
        rDocName = rDoc.DisplayName

        Dim m_Camera As Inventor.Camera
        m_Camera = ThisServer.TransientObjects.CreateCamera()
        If rDoc.DocumentType = kPartDocumentObject Then
            m_Camera.SceneObject = DirectCast(rDoc, PartDocument).ComponentDefinition
        Else
            m_Camera.SceneObject = DirectCast(rDoc, AssemblyDocument).ComponentDefinition
        End If
        m_Camera.Perspective = True

        Dim m_TO As Inventor.TransientObjects
        m_TO = ThisApplication.TransientObjects

        m_Camera.ViewOrientationType = Inventor.ViewOrientationTypeEnum.kIsoTopLeftViewOrientation
        m_Camera.Fit
        m_Camera.ApplyWithoutTransition

        ThisApplication.DisplayOptions.NewWindowDisplayMode = DisplayModeEnum.kShadedWithEdgesRendering
        ThisApplication.DisplayOptions.Show3DIndicator = False

        Dim TumbFilename As String
        TumbFilename = Dirtemp & rDocName & ".bmp"

        m_Camera.SaveAsBitmap (TumbFilename, 800, 600, m_TO.CreateColor(255, 255, 255))

        'Next

        Dim docPropertySet As PropertySet
        docPropertySet = rDoc.PropertySets.Item("Design Tracking Properties")

        'Wählen Sie die Tabellenspalten aus, die in die Excel-Datei exportiert werden sollen, sowie deren Position

        xlWorksheet.Range("A" & row).Value = bRow.ItemQuantity
        xlWorksheet.Range("B" & row).Value = docPropertySet.Item("Part Number").Value
        xlWorksheet.Range("C" & row).Value = docPropertySet.Item("Description").Value

        With xlWorksheet.Range("B" & row)
            .AddComment
            .Comment.Visible = False
            .Comment.Text (rDocName)
            .Comment.Shape.Fill.UserPicture (TumbFilename)
            .Comment.Shape.Height = 150
            .Comment.Shape.Width = 150
        End With
        xlWorksheet.Range("D" & row).Value = bRow.ItemNumber  
        xlWorksheet.Range("E" & row).Value = docPropertySet.Item("Cost").Value
        xlWorksheet.Range("F" & row).Value = docPropertySet.Item("Stock number").Value
        xlWorksheet.Range("G" & row).Value = docPropertySet.Item("Vendor").Value

        row = row + 1
    Next

    'xlWorksheet.Columns("A:Z").AutoFit

    Dim oFileName As String
    oFileName = "Export_" & oDoc.DisplayName & ".xlsx"
    MessageBox.Show (oFileName, "Exportieren nach")
    xlWorkbook.SaveAs (ThisDoc.Path & "\" & oFileName) ' Die Excel-Datei wird im Verzeichnis der Baugruppendatei gespeichert
    xlWorkbook.Close (True)
    xlApp.Quit
End Sub