CATIA - Macro de sélection d'objet depuis un liste excel

Bonjour à la Commu,

Je souhaitais vous demandez si vous le pouvez de m'éclairer sur comment puis-je automatiser une search/selection/surbrillance/modifier la couleur de la sélection.

Je souhaiterais envoyer à CATIA une liste de part dans la fenêtre de recherche, et que pour chaque ligne de ma liste, chaque références soient modifiées (changement de couleur).
Ma liste n'est pas une table de paramétrage, elle provient d'une comparaison entre les éléments du CATProduct et un fichier excel.

je vous colle ci-dessous ce que j'ai écris avec mes connaissances et ce que je peux avoir retenu de ce que j'ai vu sur internet.

La première permettrai de récupérer les informations d'excel vers catia mais ça ne fonctionne pas, puis le second code permet de trouver les correspondances des valeurs communes.
En espérant toucher quelqu'un.
Bonne journée à tous.

Code:

Sub CATMain()

Dim productDocument1 As ProductDocument
Set productDocument1 = CATIA.ActiveDocument

Set productDocument1 = CATIA.ActiveDocument

productDocument1.ExportData "C:\Users\Documents\MACRO CATIA V1\Test\PRODUCT1.txt", "txt"

Set objexcel = CreateObject("Excel.Application")
objexcel.Visible = True
Set objworkbook = objexcel.Workbooks.Open("C:\Users\Documents\MACRO CATIA V1\Test\importtxtcatiacatpartdansexcel3.xlsm")

' Exécuter une macro du classeur ouvert

'objexcel.Workbooks.Run "importref"

'objexcel.Run "importref"

'Application.Run "'importtxtcatiacatpartdansexcel3.xlsm'!importref.importref" 'toutes mes demandes d'exécution de macro excel ne fonctionne pas

For J = 1 To 10

Application.Workbooks("importtxtcatiacatpartdansexcel3.xlsm").Worksheets("Feuil1").Activate

'Dim Myselection As String

Myselection = Application.Workbooks("importtxtcatiacatpartdansexcel3.xlsm").Worksheets("Feuil1").Range("J" & 6).Value


selection1.Search "(Name=Myselection & CATAsmSearch.Part),all"
      
    Set visPropertySet1 = selection1.VisProperties
    visPropertySet1.SetRealColor 255, 0, 255, 1

    Set visProperties1 = CATIA.ActiveDocument.Selection.VisProperties
    visProperties1.SetRealOpacity 255, 1
Next J

'objexcel.Run "miseenforme"

End Sub



Code:

Sub importref()
'
' importtxtcatiacatpartdansexcel Macro
'

'
  Dim productDocument1 As ProductDocument
    Set productDocument1 = CATIA.ActiveDocument

    Dim selection1 As Selection
    Set selection1 = productDocument1.Selection
    
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\Documents\MACRO CATIA V1\Test\PRODUCT1.txt", _
        Destination:=Range("$A$1"))
        .Name = "PRODUCT1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ":"
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:6").Select
    Range("A6").Activate
    Selection.Delete Shift:=xlUp
    Selection.Replace What:="(", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=")", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
     Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    Application.Workbooks.Open("C:\Users\Documents\MACRO CATIA V1\Test\test import comparaison.xlsx").Worksheets("Sheet1").Activate
    Range("A:A").Select
    Selection.Copy
    Application.Workbooks("importtxtcatiacatpartdansexcel3.xlsm").Worksheets("Feuil1").Activate
    Range("E1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False

    
For I = 1 To 10
  
    Dim myRange As Range
    Set myRange = Worksheets("Feuil1").Range("E1:E200")
    'Sheets("Table").Activate
    Dim recherche As Range
    Set recherche = Cells(I, 1)
    
    
    Dim C As Range
    Set C = myRange.Find(What:=recherche, LookAt:=xlWhole)
    If C Is Nothing Then
        
    Else:
    
    
    Maref = Cells(I, 1).Value
    
    Cells(I, 6) = Maref
    
    End If
    
Next I

  Columns("F:F").Select
    ActiveSheet.Range("$F$1:$F$21").RemoveDuplicates Columns:=1, Header:=xlNo
  
    
End Sub


Salut Arthur,

J'avoue ne pas avoir très bien compris ce que tu cherches à faire
Mais pour les échanges avec Excel, tu peux t'inspirer de la macro d'export et d'import des propriétés d'un document CATIA disponible ici https://catiav5.forumactif.org/t1604-export-proprietes-catia-vers-excel-et-vice-versa#7120
Tu pourrais donc au lieu d'importer des valeurs de propriétés ou de paramètre affecter une couleur à chaque Part par exemple.

Bonjour Marc aka lumpazepfel

Et bien je viens de tomber sur un ouvrage de programmation CATIA que je peux faire passer par mail ou bien directement sur le portail du forum. A vous de voir.

En fait je cherche tout d'abord à faire une macro qui depuis un inputbox permettre de remplir le champ "attribut" dans "recherche avancée" et que ça le sélectionne automatiquement pour générer un changement de couleur ou encore que l'information de l'inputbox aille dans le champ "Nom" de la fenêtre "recherche général".

L'idée de ce que j'ai posté plus haut serait de remplir le champ "attribut" ou le champ "Nom" depuis des informations contenues dans un tableau excel.

Connaissez-vous un moyen de faire ceci ou encore connaissez-vous un moyen de renseigner ces champs par automotion ?

Merci d'avance. 
Dans l'attente de vous lire.
Bien à vous.

Arthur.

Salut Arthur,

Cet ouvrage m'intéresse, je t'ai envoyé mon adresse mail par message privé pour que tu puisse me le transmettre.

Ci dessous la première macro.
Il faudra encore y intégrer une fonction récursive pour parcourir le produit complet (sous produit et composant).
Ensuite on passera à l’interfaçage avec Excel.

Code:

'*******************************************************************
' Demande à l'utilisateur de saisir un PartNumber
' Recherche ces PartNumber dans le Catproduct actif
' Modifie ces caractéristiques graphiques (couleur, transparence)
' ATTENTION : ne fonctionne que sur 1 niveau
' Source:https://www.eng-tips.com/viewthread.cfm?qid=129853
' https://catiav5.forumactif.org/t1729-catia-macro-de-selection-d-objet-depuis-un-liste-excel#7457
'*******************************************************************
Sub CATMain()
Dim i As Integer
i = 1

Dim productDocument1 As ProductDocument
Set productDocument1 = CATIA.ActiveDocument

Dim product1 As Product
Set product1 = productDocument1.Product

Dim products1 As Products
Set products1 = product1.Products

' Demande à l'utilisateur de saisir un PartNumber
Dim sPartnumber As String
sPartnumber = InputBox("Entrer le PartNumber à chercher")

Dim selection1 As Selection
Set selection1 = CATIA.ActiveDocument.Selection

selection1.Clear
On Error Resume Next
    i = 1
    For Each Product In products1
        mypartnumber = products1.Item(i).PartNumber
        If mypartnumber = sPartnumber Then
            selection1.Add products1.Item(i)
            Debug.Print "Trouvé : " & mypartnumber
        End If
        i = i + 1
    Next

Dim visproperties1 As VisPropertySet
Set visproperties1 = productDocument1.Selection.VisProperties

selection1.VisProperties.SetRealColor 255, 0, 0, 1
selection1.VisProperties.SetRealOpacity 100, 1 'value between 0 (total transparency) and 255 (total opacity)
selection1.Clear

End Sub

Salut,

Voici la code (VBA) avec la fonction récursive pour chercher les Parts dans les sous product et les composant et la lecture du PARTNumber à chercher dans un tableau EXCEL.
IL faut un CATPRoduct actif dans CATIA et un tableau EXCEL avec des PartNumber dans la colonne A

Code:

'*******************************************************************
' lit une liste de PartNumber dans un tableau EXCEL
' Recherche ces PartNumber dans le Catproduct actif
' Modifie ses caractéristiques graphiques (couleur, transparence)
' Source:https://www.eng-tips.com/viewthread.cfm?qid=129853
' https://catiav5.forumactif.org/t1729-catia-macro-de-selection-d-objet-depuis-un-liste-excel#7457
' Marc Litzler 09/2021
' fonction récursive: scanne les sous produit et les composants
'*******************************************************************'******************************

Public myExcel As Object
Public sPartnumber As String
Public oCounter As Integer
Public partFound As Boolean

Sub CATMain()

oCounter = 0 'nombre de part dont la couleur est modifée
Dim line As Integer
line = 1 'première ligne du tableau Excel

Dim productDocument1 As ProductDocument
Set productDocument1 = CATIA.ActiveDocument

Dim product1 As Product
Set product1 = productDocument1.Product

Dim products1 As Products
Set products1 = product1.Products
'récupère l'application Excel et la feuille active
Set myExcel = GetObject(, "Excel.Application")
Set myworksheet = myExcel.ActiveSheet
'boule sur la colonne A qui doit contenir les PARTNumber à comparer
While myworksheet.Range("A" & line).Value <> ""
    Debug.Print line
    partFound = False
    sPartnumber = myworksheet.Range("A" & line).Value 'InputBox("Entrer le PartNumber à chercher")
    Call WalkDownTree(product1) 'scanne le CATProduct
    If partFound = True Then
        myworksheet.Range("A" & line).Interior.ColorIndex = 46 'colore en orange la cellule si le PARTNumber a été trouvé
    End If
    line = line + 1
Wend
MsgBox (oCounter & " Part trouvée(s)")

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 selection1 As Selection
    Set selection1 = CATIA.ActiveDocument.Selection
    selection1.Clear

 Dim oInstances As Products
 Set oInstances = oInProduct.Products
'-----No instances found then this is CATPart
 If oInstances.Count = 0 Then
'MsgBox "This is a CATPart with part number " & oInProduct.PartNumber

    If oInProduct.PartNumber = sPartnumber Then
        selection1.Add oInProduct
        Debug.Print "Trouvé : " & sPartnumber
        oCounter = oCounter + 1
        partFound = True
        Dim visproperties1 As VisPropertySet
        Set visproperties1 = selection1.VisProperties
        selection1.VisProperties.SetRealColor 255, 0, 0, 1 ' Rouge en couleur RGB
        selection1.VisProperties.SetRealOpacity 100, 1 'value between 0 (total transparency) and 255 (total opacity)
        selection1.Clear
    End If
    Exit Sub
 End If
'-----Found an instance therefore it is a CATProduct
'MsgBox "This is a CATProduct with part number " & oInProduct.ReferenceProduct.PartNumber

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