Export propriétés CATIA vers Excel et vice-versa

Aller en bas

Export propriétés CATIA vers Excel et vice-versa

Message par CharlyDuclos le Mer 1 Nov 2017 - 21:21

Bonjour,

je me suis inscrit sur le forum afin de trouver des réponses concernant une problématique que je rencontre actuellement.
Au sein de ma société, nous souhaiterions créer une macro permettant de :
1- Extraire vers Excel les propriétés d'un ensemble de pièce et product
2- Les compléter sous Excel manuellement
3- Réimporter ces propriétés les parts CATIA.

Nous avons trouvé une vidéo sur internet permettant de faire ceci mais le code n'était pas disponible.
Nom de la vidéo sous Youtube : Export CATIA properties to Excel and vice versa
Avez-vous déjà réaliser ce genre de macro ?

En espérant une réponse de votre part.

Cordialement,

CharlyDuclos
actif
actif

Messages : 21
Date d'inscription : 01/11/2017
Localisation : Toulouse

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par d.vincent567 le Jeu 2 Nov 2017 - 21:49

Personnellement non, mais il y a quelque personnes ici qui devraient pouvoir t'aider à réaliser une telle macro.
N'hésite pas à lire certain post déjà présent sur le forum, qui pourrait t'apporter quelque éléments de réponses.

avatar
d.vincent567
actif
actif

Messages : 81
Date d'inscription : 06/11/2016
Localisation : Brest

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par lumpazepfel le Mer 8 Nov 2017 - 23:50

Bonjour Charly,

Je n'ai pas cette macro en "stock", mais elle peut être créé.
Il faut pour cela savoir quelles sont les propriétés à exportées : uniquement les propriétés ou également des paramètres (ce qui complique le script, les propriétés ajoutées ou utilisateur sont gérées comme des paramètres).
Avec un petit descriptif des besoins je pourrai créé cette macro à condition que ce ne soit pas trop urgent!
avatar
lumpazepfel
actif
actif

Messages : 167
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par CharlyDuclos le Jeu 9 Nov 2017 - 1:35

Bonjour,

c'est un mixte des deux que nous devons exporter.
Voici la fenêtre propriété CATIA avec les renseignements à exporter :


Nous avons essayé de créer la macro mais sans résultat, nos connaissance sont encore trop restreinte pour ce genre d'utilisation surtout en liant le logiciel CATIA.
Pour le délai, de toute façon nous continuons à travailler dessus mais si vous obtenez un résultat plus vite que nous nous sommes preneur Smile

Merci de coup de main

CharlyDuclos
actif
actif

Messages : 21
Date d'inscription : 01/11/2017
Localisation : Toulouse

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par lumpazepfel le Jeu 9 Nov 2017 - 4:15

Bonjour,

Encore quelques précisions :
-Faut-il extraire les propriétés des documents contenu dans CATProduct actif (ce qui revient à analyser sa structure) ou  plus simplement les documents chargés dans CATIA ?
-Dans le cas de l’analyse du CATProduct, celui-ci peut-il être composé de sous-produit et/ ou de composant ?
-Voulez-vous vraiment exporter et éditer le nom d’instance ?

Ci dessous un exemple de code qui exporte les propriétés des documents en session dans Excel:
Code:
Sub CATMain()

Dim myDocument As Document
Dim myProduct As Product
Dim xl As Object 'Excel.Application
On Error Resume Next
    Set xl = GetObject(, "Excel.Application")
If Err <> o Then
    Set xl = CreateObject("Excel.Application")
    xl.Visible = True
End If
On Error GoTo 0

Set myworkbook = xl.workbooks.Add

Set myworksheet = xl.Sheets.Add
myworksheet.Name = "Export"
myworksheet.Range("A1").Value = "Référence"
myworksheet.Range("B1").Value = "Révision"
myworksheet.Range("C1").Value = "Définition"
myworksheet.Range("D1").Value = "Nomencalture"
myworksheet.Range("E1").Value = "Source"
myworksheet.Range("F1").Value = "Description"

For i = 1 To CATIA.Documents.Count
    Set myDocument = CATIA.Documents.Item(i)
    If TypeName(myDocument) = "PartDocument" Or TypeName(myDocument) = "ProductDocument" Then
        Set myProduct = myDocument.Product
        myworksheet.Range("A" & i+1).Value = myProduct.PartNumber
        myworksheet.Range("B" & i+1).Value = myProduct.Revision
        myworksheet.Range("C" & i+1).Value = myProduct.Definition
        myworksheet.Range("D" & i+1).Value = myProduct.Nomenclature
        myworksheet.Range("E" & i+1).Value = myProduct.Source
        myworksheet.Range("F" & i+1).Value = myProduct.DescriptionRef
        
    End If
Next

End Sub
avatar
lumpazepfel
actif
actif

Messages : 167
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par CharlyDuclos le Jeu 9 Nov 2017 - 21:47

Bonjour,

Il s'agirait d'exporter les propriétés dans le CATProduct actif oui.
Celui-ci peut être composé de Parts, ss-produits et composants...
Concernant le nom d'instance non pas forcément pour l'instant mais il se peut que dans l'avenir oui donc c'était pour avoir déjà la définition de la ligne de code à rajouter Smile

Charly

CharlyDuclos
actif
actif

Messages : 21
Date d'inscription : 01/11/2017
Localisation : Toulouse

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par CharlyDuclos le Ven 10 Nov 2017 - 19:24

@lumpazepfel, il se peut aussi qu'il y ait plusieurs fois la même part dans le product du coup il faudrait qu'elle ne sorte qu'une seule fois !
En fait, notre besoin serait de retranscrire une macro qui ferait ce qu'on peux faire avec l'onglet nomenclature mais en plus de pouvoir la modifier une fois sous excel et la réimplanter dans CATIA... Embarassed

CharlyDuclos
actif
actif

Messages : 21
Date d'inscription : 01/11/2017
Localisation : Toulouse

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par lumpazepfel le Sam 11 Nov 2017 - 3:42

Bonjour Charly,

Je m'en doutais un peu, je suis donc reparti de ma macro nomenclature ...je pense finir la parti export courant de la semaine prochaine.
Par contre si vous voulez qu'une même Part n'apparaisse qu'une seule fois, vous ne pourrez pas puis modifier les noms des instances (qui eux sont différents).

Pour le ré-import il faudrait que l'un des critères exportés ne soit pas modifié pour pouvoir retrouver le document dans CATIA : quel pourrait être ce critère? Le PartNumber ? Ou alors il faut créer dans Excel une colonne avec le valeur original et une colonne avec la nouvelle valeur.


Dernière édition par lumpazepfel le Sam 11 Nov 2017 - 8:11, édité 1 fois (Raison : ajout demande pour le réimport)
avatar
lumpazepfel
actif
actif

Messages : 167
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par CharlyDuclos le Lun 13 Nov 2017 - 19:43

Bonjour,

On va considérer que le PartNumber reste inchangé bien que je garde en tête la solution d'un nouvelle colonne version original, version modifié si jamais Smile

CharlyDuclos
actif
actif

Messages : 21
Date d'inscription : 01/11/2017
Localisation : Toulouse

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par lumpazepfel le Mar 14 Nov 2017 - 7:24

Bonsoir Charly,

Ci-joint la partie export de la macro que vous pouvez déjà tester.
Pour l’instant le test d’unicité se fait sur le nom d’instance, la même CATPart peut donc être exportée plusieurs fois si le nom d’instance est différent.
Mais ce test d’unicité peut se faire sur la référence si vous souhaitez exporter chaque CATPart qu’une seule fois.

Il faut créer une UserForm nommée UserForm1 qui contient 3 boutons nommés
CommandButtonExport, CommandButtonImport et CommandButtonEnd.



Ci-dessous le code associé à la UserForm :

Code:
Private Sub CommandButtonEnd_Click()
    UserForm1.Hide
    End
End Sub

Private Sub CommandButtonExport_Click()
'*************************
'Création du classeur Excel et de la ligne des entêtes
Set myWorkbook = myExcel.workbooks.Add
Set myWorksheet = myExcel.Sheets.Add
myWorksheet.Name = myProduct.PartNumber '"Export"
myWorksheet.Range("A1").Value = "Référence"
myWorksheet.Range("B1").Value = "Révision"
myWorksheet.Range("C1").Value = "Définition"
myWorksheet.Range("D1").Value = "Nomencalture"
myWorksheet.Range("E1").Value = "Source"
myWorksheet.Range("F1").Value = "Description"
myWorksheet.Range("G1").Value = "Instance"
myWorksheet.Range("H1").Value = "MATERIAL"
myWorksheet.Range("I1").Value = "STATE"
myWorksheet.Range("J1").Value = "THICKNESS/DIAMETER"
myWorksheet.Range("K1").Value = "OBSERVATIONS"
myWorksheet.Range("L1").Value = "LENGHT"
myWorksheet.Range("M1").Value = "WIDTH"
myWorksheet.Range("N1").Value = "MASS"
line = 2

'*************************
'Appel de la fonction récursive d'analyse du Catproduct
    Call WalkDownTree(myProduct)
    
'*************************
'Mise en forme du tableau Excel
myWorksheet.Range("A1:N1").Font.Bold = True
myWorksheet.Columns("A:N").EntireColumn.AutoFit
 

End Sub

Private Sub CommandButtonImport_Click()

    MsgBox "Ce n'est pas encore possible..."
    UserForm1.Hide
    End
End Sub

Il faut également un module principal qui contient le code suivant :

Code:
'**********************************************************************
' Macro d'export des propriétés système et utilisateurs d'un assemblage
' Réimport de ces propriétés après modification dans Excel
' Marc Litzler 11/2017
' CATVBA
' http://catiav5.forumactif.org/t1604-export-proprietes-catia-vers-excel-et-vice-versa#7113
'**********************************************************************
Public myProduct As Product
Public myDocument As Document
Public myExcel As Object
Public myWorksheet As worksheet
Public line As Integer 'n° de ligne du tableau Excel

Sub CATMain()

'********************************
' Vérifier si le document actif est un CATProduct

On Error Resume Next
Set myDocument = CATIA.ActiveDocument
If Err.Number <> o Then
    MsgBox "Il n'y a pas de fichier ouvert dans CATIA", vbCritical, "Erreur"
    End
End If
If TypeName(myDocument) <> "ProductDocument" Then
    MsgBox "Le document actif doit être un CATProduct", vbCritical, "Erreur"
    End
End If
Set myProduct = myDocument.Product

'********************************
' recherche ou déclare l'application Excel

    Set myExcel = GetObject(, "Excel.Application")
If Err <> o Then
    Set myExcel = CreateObject("Excel.Application")
    myExcel.Visible = True
End If
On Error GoTo 0

UserForm1.Show
  
End Sub

'---------------------------------------------------------------------
' WalkDownTree is a recursive function to scroll down the spec tree and output names of each item
' Source : ---Script by Emmett Ross---www.scripting4v5.com
'
Sub WalkDownTree(oInProduct As Product)

   Dim oInstances As Products
   Set oInstances = oInProduct.Products

'-----No instances found then this is CATPart

   If oInstances.Count = 0 Then
        If isInExcel(oInProduct.Name) = False Then
            myWorksheet.Range("A" & line).Value = oInProduct.PartNumber
            myWorksheet.Range("B" & line).Value = oInProduct.Revision
            myWorksheet.Range("C" & line).Value = oInProduct.Definition
            myWorksheet.Range("D" & line).Value = oInProduct.Nomenclature
            myWorksheet.Range("E" & line).Value = oInProduct.Source
            myWorksheet.Range("F" & line).Value = oInProduct.DescriptionRef
            myWorksheet.Range("G" & line).Value = oInProduct.Name
            Set myparameters = oInProduct.ReferenceProduct.UserRefProperties
            On Error Resume Next 'évite le plantage de la macro si une des propriétés n'existe pas
            myWorksheet.Range("H" & line).Value = myparameters.Item("MATERIAL").Value
            myWorksheet.Range("I" & line).Value = myparameters.Item("STATE").Value
            myWorksheet.Range("J" & line).Value = myparameters.Item("THICKNESS/DIAMETER").Value
            myWorksheet.Range("K" & line).Value = myparameters.Item("OBSERVATIONS").Value
            myWorksheet.Range("L" & line).Value = myparameters.Item("LENGHT").Value
            myWorksheet.Range("M" & line).Value = myparameters.Item("WIDTH").Value
            myWorksheet.Range("N" & line).Value = myparameters.Item("MASS").Value
            On Error GoTo 0
            line = line + 1
        End If
Exit Sub
   End If
  
'-----Found an instance therefore it is a CATProduct (ou un composant)
' Au besoins on peut différentier ici le composant du CATProduct
        If isInExcel(oInProduct.Name) = False Then
            myWorksheet.Range("A" & line).Value = oInProduct.PartNumber
            myWorksheet.Range("B" & line).Value = oInProduct.Revision
            myWorksheet.Range("C" & line).Value = oInProduct.Definition
            myWorksheet.Range("D" & line).Value = oInProduct.Nomenclature
            myWorksheet.Range("E" & line).Value = oInProduct.Source
            myWorksheet.Range("F" & line).Value = oInProduct.DescriptionRef
            myWorksheet.Range("G" & line).Value = oInProduct.Name
            Set myparameters = oInProduct.ReferenceProduct.UserRefProperties
            On Error Resume Next 'évite le plantage de la macro si une des propriétés n'existe pas
            myWorksheet.Range("H" & line).Value = myparameters.Item("MATERIAL").Value
            myWorksheet.Range("I" & line).Value = myparameters.Item("STATE").Value
            myWorksheet.Range("J" & line).Value = myparameters.Item("THICKNESS/DIAMETER").Value
            myWorksheet.Range("K" & line).Value = myparameters.Item("OBSERVATIONS").Value
            myWorksheet.Range("L" & line).Value = myparameters.Item("LENGHT").Value
            myWorksheet.Range("M" & line).Value = myparameters.Item("WIDTH").Value
            myWorksheet.Range("N" & line).Value = myparameters.Item("MASS").Value
            On Error GoTo 0
            line = line + 1
        End If
Dim k As Integer
    For k = 1 To oInstances.Count
        Dim oInst As Product
        Set oInst = oInstances.Item(k)
        oInstances.Item(k).ApplyWorkMode DESIGN_MODE
        Call WalkDownTree(oInst)
     Next

End Sub
'Fonction qui verifie si une instance a déjà été exportée
Function isInExcel(instName)
    isInExcel = False
    For l = 2 To line
     If myWorksheet.Range("G" & l).Value = instName Then
        isInExcel = True
         End If
    Next
End Function

Exemple de l’export d’un CATProduct avec sous Product et composant  :
avatar
lumpazepfel
actif
actif

Messages : 167
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par CharlyDuclos le Mar 14 Nov 2017 - 20:26

Bonjour,

j'ai testé ce matin votre macro mais il ne comprends pas la définition de worksheet ?

CharlyDuclos
actif
actif

Messages : 21
Date d'inscription : 01/11/2017
Localisation : Toulouse

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par lumpazepfel le Mar 14 Nov 2017 - 23:29

Bonjour,

Il faut que l'éditeur VBA de Catia reconnaisse les fonction du VBA Excel.
Pour cela cliquer sur "Tools" puis "References" et cocher "Microsoft Excel .. Object Library"
avatar
lumpazepfel
actif
actif

Messages : 167
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par lumpazepfel le Jeu 23 Nov 2017 - 0:03

Bonjour,

Ci joint le code qui permet d'exporter et réimporter les propriétés systèmes et utilisateur.
Le renommage de l'instance ne fonctionne pas avec cette méthode mais j'ai posté sur le site une autre macro qui permet ce renommage.
http://catiav5.forumactif.org/t1608-macro-de-renommage-des-instances#7119
Code du module principal:
Code:
'**********************************************************************
' Macro d'export des propriétés système et utilisateurs d'un assemblage
' Réimport de ces propriétés après modification dans Excel
' Marc Litzler 11/2017
' CATVBA
' http://catiav5.forumactif.org/t1604-export-proprietes-catia-vers-excel-et-vice-versa#7113
'**********************************************************************
Public myProduct As Product
Public myDocument As Document
Public myExcel As Object
Public myWorksheet As worksheet
Public line As Integer 'n° de ligne du tableau Excel

Sub CATMain()

'********************************
' Vérifier si le document actif est un CATProduct

On Error Resume Next
Set myDocument = CATIA.ActiveDocument
If Err.Number <> o Then
    MsgBox "Il n'y a pas de fichier ouvert dans CATIA", vbCritical, "Erreur"
    End
End If
If TypeName(myDocument) <> "ProductDocument" Then
    MsgBox "Le document actif doit être un CATProduct", vbCritical, "Erreur"
    End
End If
Set myProduct = myDocument.Product

'********************************
' recherche ou déclare l'application Excel

    Set myExcel = GetObject(, "Excel.Application")
If Err <> o Then
    Set myExcel = CreateObject("Excel.Application")
    myExcel.Visible = True
End If
On Error GoTo 0

UserForm1.Show
  
End Sub

'---------------------------------------------------------------------
' WalkDownTree is a recursive function to scroll down the spec tree and output names of each item
' Source : ---Script by Emmett Ross---www.scripting4v5.com
'
Sub WalkDownTree(oInProduct As Product)

   Dim oInstances As Products
   Set oInstances = oInProduct.Products
   'Récupère le nom du parent si ce n'est pas le produit de tete:
    If oInProduct.Parent.Name <> myProduct.Parent.Name Then
        myParent = oInProduct.Parent.Parent.ReferenceProduct.Parent.Name
    End If
    'Récupère le nom de fichier du parent (pour recherche composant):
    myRefProductName = oInProduct.ReferenceProduct.Parent.Name

'-----No instances found then this is CATPart

   If oInstances.Count = 0 Then
        'If isInExcel(oInProduct.Name) = False Then 'unicité de l'instance
        If isInExcel(oInProduct.PartNumber) = False Then 'unicité du PartNumber
            myWorksheet.Range("A" & line).Value = oInProduct.PartNumber
            myWorksheet.Range("B" & line).Value = oInProduct.Revision
            myWorksheet.Range("C" & line).Value = oInProduct.Definition
            myWorksheet.Range("D" & line).Value = oInProduct.Nomenclature
            myWorksheet.Range("E" & line).Value = oInProduct.Source
            myWorksheet.Range("F" & line).Value = oInProduct.DescriptionRef
            myWorksheet.Range("G" & line).Value = oInProduct.Name
            Set myparameters = oInProduct.ReferenceProduct.UserRefProperties
            On Error Resume Next 'évite le plantage de la macro si une des propriétés n'existe pas
            myWorksheet.Range("H" & line).Value = myparameters.Item("MATERIAL").Value
            myWorksheet.Range("I" & line).Value = myparameters.Item("STATE").Value
            myWorksheet.Range("J" & line).Value = myparameters.Item("THICKNESS/DIAMETER").Value
            myWorksheet.Range("K" & line).Value = myparameters.Item("OBSERVATIONS").Value
            myWorksheet.Range("L" & line).Value = myparameters.Item("LENGHT").Value
            myWorksheet.Range("M" & line).Value = myparameters.Item("WIDTH").Value
            myWorksheet.Range("N" & line).Value = myparameters.Item("MASS").Value
            On Error GoTo 0
            line = line + 1
        End If
Exit Sub
   End If
  
'-----Found an instance therefore it is a CATProduct (ou un composant)
' Au besoins on peut différentier ici le composant du CATProduct
    
    If myParent = myRefProductName Then
        ' C'est un composant
    Else
        ' C'est un Catproduct
    'End If
        'If isInExcel(oInProduct.Name) = False Then 'unicité de l'instance
        If isInExcel(oInProduct.PartNumber) = False Then 'unicité du PartNumber
            myWorksheet.Range("A" & line).Value = oInProduct.PartNumber
            myWorksheet.Range("B" & line).Value = oInProduct.Revision
            myWorksheet.Range("C" & line).Value = oInProduct.Definition
            myWorksheet.Range("D" & line).Value = oInProduct.Nomenclature
            myWorksheet.Range("E" & line).Value = oInProduct.Source
            myWorksheet.Range("F" & line).Value = oInProduct.DescriptionRef
            myWorksheet.Range("G" & line).Value = oInProduct.Name
            Set myparameters = oInProduct.ReferenceProduct.UserRefProperties
            On Error Resume Next 'évite le plantage de la macro si une des propriétés n'existe pas
            myWorksheet.Range("H" & line).Value = myparameters.Item("MATERIAL").Value
            myWorksheet.Range("I" & line).Value = myparameters.Item("STATE").Value
            myWorksheet.Range("J" & line).Value = myparameters.Item("THICKNESS/DIAMETER").Value
            myWorksheet.Range("K" & line).Value = myparameters.Item("OBSERVATIONS").Value
            myWorksheet.Range("L" & line).Value = myparameters.Item("LENGHT").Value
            myWorksheet.Range("M" & line).Value = myparameters.Item("WIDTH").Value
            myWorksheet.Range("N" & line).Value = myparameters.Item("MASS").Value
            On Error GoTo 0
            myWorksheet.Range("A" & line & ":N" & line).Interior.Color = 15921390
            line = line + 1
        End If
        End If
Dim k As Integer
    For k = 1 To oInstances.Count
        Dim oInst As Product
        Set oInst = oInstances.Item(k)
        oInstances.Item(k).ApplyWorkMode DESIGN_MODE
        Call WalkDownTree(oInst)
     Next

End Sub
'Fonction qui verifie si la valeur a déjà été exportée
Function isInExcel(valueToCheck)
    isInExcel = False
    For l = 2 To line
        'If myWorksheet.Range("G" & l).Value = valueToCheck Then 'unicité de l'instance
        If myWorksheet.Range("A" & l).Value = valueToCheck Then 'unicité du PartNumber
            isInExcel = True
        End If
    Next
End Function

Code de la userform:
Code:
Private Sub CommandButtonEnd_Click()
    UserForm1.Hide
    End
End Sub

Private Sub CommandButtonExport_Click()
'*************************
'Création du classeur Excel et de la ligne des entêtes
Set myWorkbook = myExcel.workbooks.Add
Set myWorksheet = myExcel.Sheets.Add
myWorksheet.Name = myProduct.PartNumber '"Export"
myWorksheet.Range("A1").Value = "Référence"
myWorksheet.Range("B1").Value = "Révision"
myWorksheet.Range("C1").Value = "Définition"
myWorksheet.Range("D1").Value = "Nomencalture"
myWorksheet.Range("E1").Value = "Source"
myWorksheet.Range("F1").Value = "Description"
myWorksheet.Range("G1").Value = "Instance"
myWorksheet.Range("H1").Value = "MATERIAL"
myWorksheet.Range("I1").Value = "STATE"
myWorksheet.Range("J1").Value = "THICKNESS/DIAMETER"
myWorksheet.Range("K1").Value = "OBSERVATIONS"
myWorksheet.Range("L1").Value = "LENGHT"
myWorksheet.Range("M1").Value = "WIDTH"
myWorksheet.Range("N1").Value = "MASS"
line = 2

'*************************
'Appel de la fonction récursive d'analyse du Catproduct
    Call WalkDownTree(myProduct)
    
'*************************
'Mise en forme du tableau Excel
myWorksheet.Range("A1:N1").Font.Bold = True
myWorksheet.Columns("A:N").EntireColumn.AutoFit
    
End Sub

Private Sub CommandButtonImport_Click()
Dim oInProduct As Product
'Vérification de la correspondance du classeur Excel avec le Product
For k = 1 To myExcel.workbooks.Count
Set myWorkbook = myExcel.workbooks.Item(k)
    For i = 1 To myWorkbook.Sheets.Count
        MsgBox myWorkbook.Sheets.Item(i).Name
        If myWorkbook.Sheets.Item(i).Name = myProduct.PartNumber Then
            'Set myWorksheet = myExcel.Sheets.Item(i)
            Exit For
        End If
    Next i
    If myWorkbook.Sheets.Item(i).Name = myProduct.PartNumber Then
        Set myWorksheet = myWorkbook.Sheets.Item(i)
        Exit For
    End If
Next k
If myWorksheet.Name <> myProduct.PartNumber Then
 End
End If


Dim myImpDocument 'As Document
Dim myPartNumber As String
line = 2
Do
    'On Error Resume Next
    On Error GoTo 0
    myPartNumber = myWorksheet.Range("A" & line).Value
    If myDocument.Product.PartNumber <> myPartNumber Then
        'Set myImpDocument = CATIA.Documents.Item(myPartNumber)
        Set myImpDocument = myDocument.GetItem(myPartNumber)
        Set oInProduct = myImpDocument
    Else
        'Set myImpDocument = myDocument
        Set oInProduct = myDocument.Product
    End If
  
    
    Set myparameters = oInProduct.UserRefProperties
    
    'oInProduct.PartNumber = myWorksheet.Range("O" & line).Value '--> pour modifier le PartNumber
    oInProduct.Revision = myWorksheet.Range("B" & line).Value
    oInProduct.Definition = myWorksheet.Range("C" & line).Value
    oInProduct.Nomenclature = myWorksheet.Range("D" & line).Value
    oInProduct.Source = myWorksheet.Range("E" & line).Value
    oInProduct.DescriptionRef = myWorksheet.Range("F" & line).Value
    'Le renommage des instances ne fonction pas avec cette méthode
    'oInProduct.Name = myWorksheet.Range("G" & line).Value
    On Error Resume Next
    myparameters.Item("MATERIAL").Value = myWorksheet.Range("H" & line).Value
    myparameters.Item("STATE").Value = myWorksheet.Range("I" & line).Value
    myparameters.Item("THICKNESS/DIAMETER").Value = myWorksheet.Range("J" & line).Value
    myparameters.Item("OBSERVATIONS").Value = myWorksheet.Range("K" & line).Value
    myparameters.Item("LENGHT").Value = myWorksheet.Range("L" & line).Value
    myparameters.Item("WIDTH").Value = myWorksheet.Range("M" & line).Value
    myparameters.Item("MASS").Value = myWorksheet.Range("N" & line).Value
    
    line = line + 1
Loop Until myWorksheet.Range("A" & line).Value = ""
       
    
    UserForm1.Hide
    MsgBox "Import terminé"
    End
End Sub
L'import peut se faire directement après avoir modifié le fichier Excel sans arrêter la macro ou non, les 2 fichiers CAtProduct et excel correspondants peuvent être fermés et ré-ouverts plus tard. Il faut dans ce cas relancer la macor et cliquer sur "Import".

A tester et a adapter en fonction de ce qu'il vous faut exactement.
avatar
lumpazepfel
actif
actif

Messages : 167
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par CharlyDuclos le Ven 24 Nov 2017 - 21:37

WAOUHHH merci beaucoup Marc ça fonctionne parfaitement et va nous faire gagner un temps considérable Smile

CharlyDuclos
actif
actif

Messages : 21
Date d'inscription : 01/11/2017
Localisation : Toulouse

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par CharlyDuclos le Mar 28 Nov 2017 - 2:03

Bonjour Marc,

je suis en train d'essayé de modifier la macro afin d'insérer une progress bar pour savoir où en est le programme mais je rencontre encore quelques difficultés.

J'ai trouvé une solution ici :http://catiav5.forumactif.org/t1209-creer-une-progress-barre-dans-catia
mais je n'arrive pas à l'intégrer au bon endroit dans la macro et la faire fonctionner.

As-tu une idée ?

CharlyDuclos
actif
actif

Messages : 21
Date d'inscription : 01/11/2017
Localisation : Toulouse

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par lumpazepfel le Mar 28 Nov 2017 - 5:32

Bonjour Charly,

La difficulté avec les progressbar c'est de définir en avance la fin de l'évènement. Sad
Il y a une autre possibilité que la classe proposée par Docserta:
Il existe un outil spécifique dans la Toolbox des UserForm.
Pour rajouter cet outil :
1.Clic droit dans la fenêtre Toolbox » et « Additional Controls »
2. Cocher « Microsoft ProgressBar Control »
3.Cliquer OK
4.L’outil « ProgressBar » est dispo, il suffit de le glisser dans la UserFrom.


Il faut alors dans la macro  trouver les infos qui permettront de définir le début et la fin de la barre.
Pour l’export on ne sait pas d’avance combien il y aura de ligne (en particulier à cause des composants), mais on peut faire une approche avec le nombre de documents en session (à condition qu’il n’y ait pas trop de CATProduct ouvert simultanément).
'initialisation de la  ProgressBar
UserForm1.ProgressBar1.Min = 1
UserForm1.ProgressBar1.Max = CATIA.Documents.Count + 1
UserForm1.ProgressBar1.Value = 1
Dans la boucle :
  On Error Resume Next 'pour éviter le plantage si le nombre dépasse la valeur max
  UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1
  On Error GoTo 0

Pour l’import j’utilise le nombre de ligne du tableau Excel:
nbline = myWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row
' initialisation ProgressBar
UserForm1.ProgressBar1.Min = 1
UserForm1.ProgressBar1.Max = nbline - 1
UserForm1.ProgressBar1.Value = 1
Dans la boucle :    UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1

Code principal complété:
Code:
'**********************************************************************
' Macro d'export des propriétés système et utilisateurs d'un assemblage
' Réimport de ces propriétés après modification dans Excel
' Marc Litzler 11/2017
' CATVBA
' http://catiav5.forumactif.org/t1604-export-proprietes-catia-vers-excel-et-vice-versa#7113
'**********************************************************************
Public myProduct As Product
Public myDocument As Document
Public myExcel As Object
Public myWorksheet As worksheet
Public line As Integer 'n° de ligne du tableau Excel

Sub CATMain()

'********************************
' Vérifier si le document actif est un CATProduct

On Error Resume Next
Set myDocument = CATIA.ActiveDocument
If Err.Number <> o Then
    MsgBox "Il n'y a pas de fichier ouvert dans CATIA", vbCritical, "Erreur"
    End
End If
If TypeName(myDocument) <> "ProductDocument" Then
    MsgBox "Le document actif doit être un CATProduct", vbCritical, "Erreur"
    End
End If
Set myProduct = myDocument.Product

'********************************
' recherche ou déclare l'application Excel

    Set myExcel = GetObject(, "Excel.Application")
If Err <> o Then
    Set myExcel = CreateObject("Excel.Application")
    myExcel.Visible = True
End If
On Error GoTo 0
'paramétrage progress bar
UserForm1.ProgressBar1.Min = 1
UserForm1.ProgressBar1.Max = CATIA.Documents.Count + 1
UserForm1.ProgressBar1.Value = 1

UserForm1.Show
  
End Sub

'---------------------------------------------------------------------
' WalkDownTree is a recursive function to scroll down the spec tree and output names of each item
' Source : ---Script by Emmett Ross---www.scripting4v5.com
'
Sub WalkDownTree(oInProduct As Product)

   Dim oInstances As Products
   Set oInstances = oInProduct.Products
   On Error Resume Next
   UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1
   On Error GoTo 0
   'Récupère le nom du parent si ce n'est pas le produit de tete:
    If oInProduct.Parent.Name <> myProduct.Parent.Name Then
        myParent = oInProduct.Parent.Parent.ReferenceProduct.Parent.Name
    End If
    'Récupère le nom de fichier du parent (pour recherche composant):
    myRefProductName = oInProduct.ReferenceProduct.Parent.Name

'-----No instances found then this is CATPart

   If oInstances.Count = 0 Then
        'If isInExcel(oInProduct.Name) = False Then 'unicité de l'instance
        If isInExcel(oInProduct.PartNumber) = False Then 'unicité du PartNumber
            myWorksheet.Range("A" & line).Value = oInProduct.PartNumber
            myWorksheet.Range("B" & line).Value = oInProduct.Revision
            myWorksheet.Range("C" & line).Value = oInProduct.Definition
            myWorksheet.Range("D" & line).Value = oInProduct.Nomenclature
            myWorksheet.Range("E" & line).Value = oInProduct.Source
            myWorksheet.Range("F" & line).Value = oInProduct.DescriptionRef
            myWorksheet.Range("G" & line).Value = oInProduct.Name
            Set myparameters = oInProduct.ReferenceProduct.UserRefProperties
            On Error Resume Next 'évite le plantage de la macro si une des propriétés n'existe pas
            myWorksheet.Range("H" & line).Value = myparameters.Item("MATERIAL").Value
            myWorksheet.Range("I" & line).Value = myparameters.Item("STATE").Value
            myWorksheet.Range("J" & line).Value = myparameters.Item("THICKNESS/DIAMETER").Value
            myWorksheet.Range("K" & line).Value = myparameters.Item("OBSERVATIONS").Value
            myWorksheet.Range("L" & line).Value = myparameters.Item("LENGHT").Value
            myWorksheet.Range("M" & line).Value = myparameters.Item("WIDTH").Value
            myWorksheet.Range("N" & line).Value = myparameters.Item("MASS").Value
            On Error GoTo 0
            line = line + 1
        End If
Exit Sub
   End If
  
'-----Found an instance therefore it is a CATProduct (ou un composant)
' Au besoins on peut différentier ici le composant du CATProduct
    
    If myParent = myRefProductName Then
        ' C'est un composant
    Else
        ' C'est un Catproduct
    'End If
        'If isInExcel(oInProduct.Name) = False Then 'unicité de l'instance
        If isInExcel(oInProduct.PartNumber) = False Then 'unicité du PartNumber
            myWorksheet.Range("A" & line).Value = oInProduct.PartNumber
            myWorksheet.Range("B" & line).Value = oInProduct.Revision
            myWorksheet.Range("C" & line).Value = oInProduct.Definition
            myWorksheet.Range("D" & line).Value = oInProduct.Nomenclature
            myWorksheet.Range("E" & line).Value = oInProduct.Source
            myWorksheet.Range("F" & line).Value = oInProduct.DescriptionRef
            myWorksheet.Range("G" & line).Value = oInProduct.Name
            Set myparameters = oInProduct.ReferenceProduct.UserRefProperties
            On Error Resume Next 'évite le plantage de la macro si une des propriétés n'existe pas
            myWorksheet.Range("H" & line).Value = myparameters.Item("MATERIAL").Value
            myWorksheet.Range("I" & line).Value = myparameters.Item("STATE").Value
            myWorksheet.Range("J" & line).Value = myparameters.Item("THICKNESS/DIAMETER").Value
            myWorksheet.Range("K" & line).Value = myparameters.Item("OBSERVATIONS").Value
            myWorksheet.Range("L" & line).Value = myparameters.Item("LENGHT").Value
            myWorksheet.Range("M" & line).Value = myparameters.Item("WIDTH").Value
            myWorksheet.Range("N" & line).Value = myparameters.Item("MASS").Value
            On Error GoTo 0
            myWorksheet.Range("A" & line & ":N" & line).Interior.Color = 15921390
            line = line + 1
        End If
        End If
Dim k As Integer
    For k = 1 To oInstances.Count
        Dim oInst As Product
        Set oInst = oInstances.Item(k)
        oInstances.Item(k).ApplyWorkMode DESIGN_MODE
        Call WalkDownTree(oInst)
     Next

End Sub
'Fonction qui verifie si la valeur a déjà été exportée
Function isInExcel(valueToCheck)
    isInExcel = False
    For l = 2 To line
        'If myWorksheet.Range("G" & l).Value = valueToCheck Then 'unicité de l'instance
        If myWorksheet.Range("A" & l).Value = valueToCheck Then 'unicité du PartNumber
            isInExcel = True
        End If
    Next
End Function

Code UserForm complété:
Code:
Private Sub CommandButtonEnd_Click()
    UserForm1.Hide
    End
End Sub

Private Sub CommandButtonExport_Click()
'*************************
'Création du classeur Excel et de la ligne des entêtes
Set myWorkbook = myExcel.workbooks.Add
Set myWorksheet = myExcel.Sheets.Add
myWorksheet.Name = myProduct.PartNumber '"Export"
myWorksheet.Range("A1").Value = "Référence"
myWorksheet.Range("B1").Value = "Révision"
myWorksheet.Range("C1").Value = "Définition"
myWorksheet.Range("D1").Value = "Nomencalture"
myWorksheet.Range("E1").Value = "Source"
myWorksheet.Range("F1").Value = "Description"
myWorksheet.Range("G1").Value = "Instance"
myWorksheet.Range("H1").Value = "MATERIAL"
myWorksheet.Range("I1").Value = "STATE"
myWorksheet.Range("J1").Value = "THICKNESS/DIAMETER"
myWorksheet.Range("K1").Value = "OBSERVATIONS"
myWorksheet.Range("L1").Value = "LENGHT"
myWorksheet.Range("M1").Value = "WIDTH"
myWorksheet.Range("N1").Value = "MASS"
line = 2

'*************************
'Appel de la fonction récursive d'analyse du Catproduct
    Call WalkDownTree(myProduct)
    
'*************************
'Mise en forme du tableau Excel
myWorksheet.Range("A1:N1").Font.Bold = True
myWorksheet.Columns("A:N").EntireColumn.AutoFit
 MsgBox "Export terminé"
 UserForm1.ProgressBar1.Value = 1
End Sub

Private Sub CommandButtonImport_Click()
Dim oInProduct As Product
'Vérification de la correspondance du classeur Excel avec le Product
For k = 1 To myExcel.workbooks.Count
Set myWorkbook = myExcel.workbooks.Item(k)
    For i = 1 To myWorkbook.Sheets.Count
        'MsgBox myWorkbook.Sheets.Item(i).Name
        If myWorkbook.Sheets.Item(i).Name = myProduct.PartNumber Then
            'Set myWorksheet = myExcel.Sheets.Item(i)
            Exit For
        End If
    Next i
    If myWorkbook.Sheets.Item(i).Name = myProduct.PartNumber Then
        Set myWorksheet = myWorkbook.Sheets.Item(i)
        Exit For
    End If
Next k
If myWorksheet.Name <> myProduct.PartNumber Then
 End
End If

Dim myImpDocument 'As Document
Dim myPartNumber As String
Dim nbline As Integer
nbline = myWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'paramétrage progress bar
UserForm1.ProgressBar1.Min = 1
UserForm1.ProgressBar1.Max = nbline - 1
UserForm1.ProgressBar1.Value = 1
line = 2
Do
    'On Error Resume Next
    On Error GoTo 0
    myPartNumber = myWorksheet.Range("A" & line).Value
    If myDocument.Product.PartNumber <> myPartNumber Then
        'Set myImpDocument = CATIA.Documents.Item(myPartNumber)
        Set myImpDocument = myDocument.GetItem(myPartNumber)
        Set oInProduct = myImpDocument
    Else
        'Set myImpDocument = myDocument
        Set oInProduct = myDocument.Product
    End If
      
    Set myparameters = oInProduct.UserRefProperties
    
    'oInProduct.PartNumber = myWorksheet.Range("O" & line).Value
    oInProduct.Revision = myWorksheet.Range("B" & line).Value
    oInProduct.Definition = myWorksheet.Range("C" & line).Value
    oInProduct.Nomenclature = myWorksheet.Range("D" & line).Value
    oInProduct.Source = myWorksheet.Range("E" & line).Value
    oInProduct.DescriptionRef = myWorksheet.Range("F" & line).Value
    'Le renommage des instances ne fonction pas avec cette méthode
    'oInProduct.Name = myWorksheet.Range("G" & line).Value
    On Error Resume Next
    myparameters.Item("MATERIAL").Value = myWorksheet.Range("H" & line).Value
    myparameters.Item("STATE").Value = myWorksheet.Range("I" & line).Value
    myparameters.Item("THICKNESS/DIAMETER").Value = myWorksheet.Range("J" & line).Value
    myparameters.Item("OBSERVATIONS").Value = myWorksheet.Range("K" & line).Value
    myparameters.Item("LENGHT").Value = myWorksheet.Range("L" & line).Value
    myparameters.Item("WIDTH").Value = myWorksheet.Range("M" & line).Value
    myparameters.Item("MASS").Value = myWorksheet.Range("N" & line).Value
    
    line = line + 1
    UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1
Loop Until myWorksheet.Range("A" & line).Value = ""
      
    UserForm1.Hide
    MsgBox "Import terminé"
    End
End Sub
avatar
lumpazepfel
actif
actif

Messages : 167
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Propriété de visualisation dans la nomenclature

Message par Spo le Mar 20 Mar 2018 - 22:08

Bonjour le forum,

topic
Je me permet de renchérir sur ce post car je n'arrive pas a trouver comment exploiter les propriétés encadrées en rouge dans l'image ci-dessous:



Je voudrais être capable de récupéré le status de la checkbox et (si possible) pouvoir la cocher/décocher.
D'autre part, je voudrais exporter le chemin pour pouvoir comparer les noms d'instance, de part et du fichier lui même pour m'assurer qu'ils sont identiques.

Merci !

Spo
timide
timide

Messages : 5
Date d'inscription : 20/12/2017
Localisation : Blagnac

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par lumpazepfel le Mer 21 Mar 2018 - 0:57

Bonjour Simon,

A ma connaissance et d'après plusieurs forum, la coche "Visualiser dans la nomenclature" n'est pas accessible en VBA.

Pour le lien vers la référence, il faut utiliser la propriété "fullname" du document"

Extrait de l'aide:
Property FullName( ) As CATBSTR (Read Only)

Returns the document's full file name, including its path.
Example:
This example retrieves in DocFullName the Doc document's full file name.
DocFullName = Doc.FullName

The returned value is like this:
e:\users\psr\Parts\MyNicePart.CATPart
avatar
lumpazepfel
actif
actif

Messages : 167
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Re: Export propriétés CATIA vers Excel et vice-versa

Message par Contenu sponsorisé


Contenu sponsorisé


Revenir en haut Aller en bas

Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum