Miniatures associées à une Liste de Pièces Inventor (Nomenclature)

Résolu le 18 juillet 2017 avec la version Inventor 2018.1 (voir en bas de l'article)

Sur le site MODE THE MACHINE Miniatures associées à une Liste de Pièces Inventor (Nomenclature)

Un source VBA toujours d'actualité qui permet de créer un fichier Word avec les Miniatures associées à votre Liste de Pièces (Nomenclature) depuis une mise en plan IDW ou DWG Inventor.

NB: La couleur de fond de la miniature est en fonction de votre paramètre Arrière-plan d'Inventor.

dans l'image ci-dessous un fond blanc a été créé avec Paint et sauvé dans le dossier C:\Users\Public\Documents\Autodesk\Inventor 2017\Backgrounds.

Dans Inventor ouvrir l'Editeur VBA situé dans l'Onglet OUTIL du Ruban.

Dans l'éditeur, choisissez :

Projet de l'Application (Default.ivb) Module1

Cela modifiera le fichier Default.ivb qui se trouve dans le dossier C:\Users\Public\Documents\Autodesk\Inventor 2017, si vos Options d'application Inventor sont configurées avec ce chemin.

Sélectionner le code VBA ci-dessous enfin de le copier dans la fenêtre du Module1 (Ctrl+C puis Ctrl+V)

Public Sub MiniaturesDansNomenclature()
    ' Vérifiez que vous êtes en mise en plan.
    On Error Resume Next
    Dim drawDoc As DrawingDocument
    Set drawDoc = ThisApplication.ActiveDocument
    If Err Then
        MsgBox "Un dessin doit être actif."
        Exit Sub
    End If
    
    ' Vérifiez que vous avez sélectionné une Liste de pièces.
    Dim partList As PartsList
    Set partList = drawDoc.SelectSet.Item(1)
    If Err Then
        MsgBox "Sélectionnez une liste de pièces."
        Exit Sub
    End If
    On Error GoTo 0
    
    Dim wordApp As Word.Application
    On Error Resume Next
    ' Connexion à l'instance Word.
    Set wordApp = GetObject(, "Word.Application")
    If Err Then
        Err.Clear
        
        ' Start Word.
        Set wordApp = CreateObject("Word.Application")
        If Err Then
            MsgBox "Impossible de lancer Word."
            Exit Sub
        End If
    End If
    On Error GoTo 0
    
    On Error GoTo ErrorFound
    wordApp.Visible = False
    
    ' Création d'un nouveau document Word.
    Dim wordDoc As Word.Document
    Set wordDoc = wordApp.Application.Documents.Add
    
    ' Création d'un tableau identique à la liste de pièces sélectionnée).
    Dim partListTable As Table
    Set partListTable = wordDoc.Tables.Add(wordApp.Selection.Range, partList.PartsListRows.Count + 1, partList.PartsListColumns.Count + 1, wdWord9TableBehavior, wdAutoFitFixed)
    
    ' Copie des entêtes de la liste de pièces.
    Dim i As Integer
    For i = 0 To partList.PartsListColumns.Count
        Dim myrange As Range
        Set myrange = partListTable.Cell(1, i + 1).Range
        myrange.End = partListTable.Cell(1, i + 1).Range.End
        myrange.Select

        If i = 0 Then
            Call wordApp.Selection.TypeText("Aperçu")
        Else
            Call wordApp.Selection.TypeText(partList.PartsListColumns.Item(i).Title)
        End If
    Next

    ' Itération des rangées de la liste de pièces.
    Dim rowIndex As Integer
    rowIndex = 1
    Dim partListRow As PartsListRow
    For Each partListRow In partList.PartsListRows
        ThisApplication.StatusBarText = "Processing part list row " & rowIndex & " of " & partList.PartsListRows.Count & "..."
        rowIndex = rowIndex + 1
        
        If partListRow.Visible Then
            ' Choix de la première cellule de la rangée.
            Set myrange = partListTable.Cell(rowIndex, 1).Range
            myrange.End = partListTable.Cell(rowIndex, 1).Range.End
            myrange.Select
        
            ' Obtention de l'aperçu du document associée à la rangée.
            Dim drawBomRow As DrawingBOMRow
            Set drawBomRow = partListRow.ReferencedRows.Item(1)
            Dim refDoc As Document
            Set refDoc = drawBomRow.BOMRow.ComponentDefinitions.Item(1).Document
            
            On Error Resume Next
            Dim thumbNail As IPictureDisp
            Set thumbNail = refDoc.thumbNail
            If Err.Number = 0 Then
                ' Sauvegarde de l'aperçu dans un fichier.
                Call SavePicture(thumbNail, "C:\Temp\TempThumb.bmp")
                
                Dim shape As Word.InlineShape
                Set shape = wordApp.Selection.InlineShapes.AddPicture("C:\Temp\TempThumb.bmp", False, True)
                shape.LockAspectRatio = True
                shape.Height = 50
            Else
                Call wordApp.Selection.TypeText("Aperçu non valable")
            End If
            On Error GoTo ErrorFound
    
            ' Copy the rest of the part list info into the table for this row.
            For i = 1 To partList.PartsListColumns.Count
                Set myrange = partListTable.Cell(rowIndex, i + 1).Range
                myrange.End = partListTable.Cell(rowIndex, i + 1).Range.End
                myrange.Select
        
                Call wordApp.Selection.TypeText(partListRow.Item(i).Value)
            Next
        End If
    Next
    
    ThisApplication.StatusBarText = "Fin"
    wordApp.Visible = True
    Exit Sub

ErrorFound:
    MsgBox "Erreur inconnue."
    wordApp.Visible = True
End Sub

Après avoir coller le code VBA dans le Module 1.

Ajouter la Référence Microsoft Word Object Library

Maintenant nous pouvons utiliser cette Macro VBA depuis une mise en plan contenant une Liste de pièces.

Sélection de la Liste de pièces puis lancer la Macro MiniaturesDansNomenclature soit avec le raccourci clavier Alt+F8 ou par le ruban Outils---> Macros

Vous obtiendrez un fichier Word avec vos colonnes de votre liste de pièces complété de l'Aperçu en première colonne.

Si votre liste de pièces est volumineuse, vous pouvez anticiper en modifiant à la fois la macro VBA à la ligne Shape Height = 50

cette valeur défini la taille de la miniature donc aussi la hauteur de rangée dans le fichier Word. (25 = petite vignette, 50 = moyenne vignette, 100 = grande vignette)

Modifier la chaîne de caractère dans le code VBA de la colonne qui contient l'Aperçu avec le mot qui vous convient le mieux, (Vignette, Miniature ....)

et aussi adapter les valeurs de marges et nombre de colonnes de Word avec un document vierge avant d'utiliser la Macro Inventor :

Améliorations apportées aux miniatures de la nomenclature avec Inventor 2018.1

Les vues miniatures sont désormais exportées en même temps que les autres informations dans la boîte de dialogue Nomenclature.

La colonne Miniature doit être incluse en tant que telle dans la boîte de dialogue Nomenclature pour que les miniatures puissent être exportées vers le fichier externe.

Inventor 2018.1	Excel