🗓️ Note : Cet article est une archive importée de mon ancien blog. Certaines informations peuvent ne plus être à jour.
Voici un petit programme en VBA pour importer / éditer / exporter les propriétés d’un plan entre Inventor et Excel
Bonjour.
Dans la vraie vie de la réalité vraie, je suis dessinateur industriel et j’utilise couramment Autodesk Inventor. C’est pourquoi j’ai créé ce petit programme…
Or, il m’arrive souvent d’avoir à éditer le cartouche d’une dizaine de plans simultanément (par exemple, renvoyer tout un jeu de plan avec la date du jour). Et il se trouve que dans ma société, il a été décidé qu’une page = un document ; càd 1 sheet = 1 dwg . (Bien qu’Inventor peut gérer plusieurs sheet dans le même fichier mais passons…)
Aussi, les informations du cartouche sont définis dans les propriétés du plan. C’est donc barbant de modifier chaque champs à la main et de faire ça pour chaque sheet.
J’ai donc créé ce petit programme qui permet d’extraire pour chaque document ouvert sur Inventor, toutes les propriétés et d’afficher ça sous forme de tableau sur Excel. On peut ainsi tout modifier et tout réinjecter dans Inventor.
Bon, c’est codé avec les pieds, y’a certainement pas mal d’erreurs … Néanmoins ça marche. Et si c’est pas cassé pourquoi le réparer ?
N’hésitez pas à me faire vos retours !
Le code est là en dessous (pour vous éviter de télécharger un vilain .xlsm)
Option Explicit
'DECLARATION DES VARIABLES "PUBLIC"
Public inventorApp As Inventor.Application
Public iDoc As Inventor.Document
Public CustomPropertySet As PropertySet
Public str_propname As String
Public j As Double
Public k As Double
Public lRow As Integer
Public lCol As Integer
Sub ExtractPropInventor()
'========== CALCUL DU TEMPS D'EXECUTION ==========
' Déclarations
Dim temps_debut As Single
Dim duree As Single
Dim doc As Document
' Récupérer le temps initial
temps_debut = Timer
'=========================================================
'Stop refresh
Application.ScreenUpdating = False
'Variables -> voir "module_VARIABLES"
'Passage de la table en type de données TEXT
Cells.Select
Selection.NumberFormat = "@"
'Connection à une instance inventor existante
On Error Resume Next
Set inventorApp = GetObject(, "Inventor.Application")
'Si inventor n'est pas ouvert, message d'erreur
If Err Then
MsgBox "Veuillez ouvrir une instance Inventor."
Exit Sub
End If
' Inventor Visible :
inventorApp.Visible = True
'RECUPERATION DES PROPRIETES
' Balayage de tous les documents ouvert (ipt,iam,dwg...)
' Reset de la variable colonne
k = 3
For Each iDoc In inventorApp.Documents
'Si le document est un dessin alors
If iDoc.DocumentType = kDrawingDocumentObject Then
' Récupération du titre du dessin pour titre de la colonne
Cells(1, k).value = iDoc.DisplayName
' Récupération des propriétés utilisateurs
Set CustomPropertySet = iDoc.PropertySets.item("Inventor User Defined Properties")
' Reset de la variable ligne
j = 2
' Pour chaque champs dans la liste des propriétés utilisateurs
For Each item In CustomPropertySet
'on cherche si la propriété existe déja , si elle existe, on écrit la valeur
On Error Resume Next
findedRow = WorksheetFunction.Match(item.Name, Range("B:B"), 0)
If findedRow <> 0 Then
Cells(findedRow, k).value = item.value
'reset de findedRow
findedRow = 0
Else
'sinon on crée la propriété tout en bas du tableau
'on cherche la derniére ligne
lRow = Cells(Rows.Count, 2).End(xlUp).Row
'que l'on incrémente de 1 pour avoir une ligne vierge
lRow = lRow + 1
Cells(lRow, 2).value = item.Name
Cells(lRow, k).value = item.value
'reset
findedRow = 0
End If
Next item
'colonne suivante
k = k + 1
End If
Next iDoc
'Ecriture de la cellule A1
Range("B1").value = "PROPRIETES"
'Ajustement automatique de la largeur des colonnes
'Passage de la table en type de données TEXT
Cells.Select
Cells.EntireColumn.AutoFit
Selection.NumberFormat = "@"
'Suppression du jaune
Cells.Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A1").Select
'Reactive refresh
Application.ScreenUpdating = True
'========== CALCUL DU TEMPS D'EXECUTION ==========
' Calculer la durée d'exécution
duree = Timer - temps_debut
' Afficher la durée d'exécution
MsgBox ("EXTRACT REUSSI ! Durée d'éxécution : " & duree)
'=========================================================
End Sub
Sub InsertPropInventor()
'========== CALCUL DU TEMPS D'EXECUTION ==========
' Déclarations
Dim temps_debut As Single
Dim duree As Single
Dim doc As Document
' Récupérer le temps initial
temps_debut = Timer
'=========================================================
'Stop refresh
Application.ScreenUpdating = False
'Variables -> voir "module_VARIABLES"
Dim customProp As Property
'Connection à une instance inventor existante
On Error Resume Next
Set inventorApp = GetObject(, "Inventor.Application")
'Si inventor n'est pas ouvert, message d'erreur
If Err Then
MsgBox "Veuillez ouvrir une instance Inventor."
Exit Sub
End If
' Inventor Visible :
inventorApp.Visible = True
'désactivation du screen update
inventorApp.ScreenUpdating = False
'DETERMINATION DES LIMITES DU TABLEAU
'Recherche de la derniére ligne sur la colonne 1
lRow = Cells(Rows.Count, 2).End(xlUp).Row
'Recherche de la derniére colonne sur la ligne 1
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
'INSERTION DES PROPRIETES
'reset des variables
k = 3
'Balayage tous les documents ouverts sur inventor (ipt,iam,dwg)
For Each iDoc In inventorApp.Documents
'Si le document est un dessin alors
If iDoc.DocumentType = kDrawingDocumentObject Then
'Balayage du tableau excel
For k = 3 To lCol
'Si le nom du document correspond au nom de la cellule
If iDoc.DisplayName = Cells(1, k).value Then
'définition de la variable CustomPropertySet
Set CustomPropertySet = iDoc.PropertySets.item("Inventor User Defined Properties")
'Sur chaque ligne du tableau
For i = 2 To lRow
'on récupére le nom de la propriété
str_propname = Cells(i, 2).value
'On vérifie si la cellule a été modifié (via sa couleur)
If Cells(i, k).Interior.ColorIndex = 6 Then
'si la cellule contenant la valeur est vide, alors on ne met rien dans la propriété
If IsEmpty(Cells(i, k)) Then
CustomPropertySet.item(str_propname).value = vbNullString
'sinon on met la valeur souhaitée
Else
CustomPropertySet.item(str_propname).value = Cells(i, k).value
End If
'Si la cellule n'a pas été modifié, on passe à la ligne suivante
Else
End If
Next i
End If
Next k
End If
Next iDoc
'réactivation du screen update
inventorApp.ScreenUpdating = True
'Reactive refresh
Application.ScreenUpdating = True
'========== CALCUL DU TEMPS D'EXECUTION ==========
' Calculer la durée d'exécution
duree = Timer - temps_debut
' Afficher la durée d'exécution
MsgBox ("INSERT REUSSI ! Durée d'éxécution : " & duree)
'=========================================================
End Sub
