Mise à jour d'un cartouche personnalisé en fonction des paramètres de la pièce

Salut à tous;
moi c'est Paul, je post ça car je suis un peu bloqué et je commence à m'arracher les cheveux.
je vous expose mon problème, depuis quelque temps je développe un ensemble de macros en VBA (Nomenclature auto, Création de pièce personnaliser etc...) pour facilité la vie au bureau.
jusque la j'ai toujours réussi à bricoler et a m'en sortir mais la ca coince...
il s'agit d'une macro qui devrait remplir automatiquement les paramètres des zones de texte du cartouche de mise en plan, en fonction des paramètres perso de la pièce 3D.

je souhaiterai récupérer le liens de la vue principal et du coup toutes les propriétés de la pièce 3d qui correspond.

voici mon code VBA pour le moment:

Option Explicit
Sub CATMain()

Dim Drw As DrawingDocument
Dim DrwSheet As DrawingSheet
Dim DrwViews As DrawingViews
Dim DrwView As DrawingView
Dim PartParent As Documents
Dim Parametre3D As Parameters
Dim I As Integer

Set Drw = CATIA.ActiveDocument
'MsgBox (Drw.Name)

Set DrwSheet = Drw.Sheets.ActiveSheet
'MsgBox (DrwSheet.Name)

Set DrwViews = DrwSheet.Views
Set DrwView = DrwViews.ActiveView
'MsgBox (Drwview.Name)

Set PartParent = DrwView.GenerativeBehavior.Document.Parent

If InStr(PartParent.Name, ".CATPart") <> 0 Then

Set Parametre3D = PartParent.Part.Parameters
MsgBox ("c'est une part")

Else

Set Parametre3D = PartParent.Product.Parameters.RootParameterSet.DirectParameters
MsgBox ("c'est un product")

End If

End Sub

Je vous remercie par avance, toutes aide est la bienvenue.

Bonjour,

Essaie ça:

Set Doc_3D = Drw.Sheets.Item(1).Views.Item(3).GenerativeBehavior.Document.Parent 'lien de la 1ère projection
If InStr(Doc_3D.Name, ".CATPart") <> 0 Then
Set Parameters_3D = Doc_3D.Part.Parameters
Else
Set Parameters_3D = Doc_3D.Product.Parameters.RootParameterSet.DirectParameters
End If


Tu peux aussi t'inspirer de la macro Dassault qui se trouve sous:
C:\Program Files\Dassault Systemes\B22\\win_b64\VBScript\FrameTitleBlock\ Drawing_Titleblock_Sample1.CATScript
(chemin à adapter en fonction de ton installation); voir le module "Sub CATLinks"

Bonjour,
Je ne reçois la notification de ton message que ce matin.

J'ai fait un code qui fonctionne et qui devrait répondre à ton besoin.

Je préfère balayer toutes les vues jusqu'à trouvé celle qui a un lien 3D car ce n'est pas forcément une vue issue du 3D qui est activée.

Code:


Option Explicit

 
Sub CATMain()

Dim oDrawing As DrawingDocument
Dim oVue As DrawingView
Dim oTextePN As DrawingText
Dim oTexteRepere As DrawingText
Dim oTexteNAffaireRef As DrawingText
Dim oTexteMatiere As DrawingText
Dim iCalques As Integer
Dim iVues As Integer

If TypeName(CATIA.ActiveDocument) = "DrawingDocument" Then
Set oDrawing = CATIA.ActiveDocument
Else
MsgBox "Veuillez activer le dessin d'abord"
End 'ou "Exit Sub" selon besoin.
End If

'Il faut qu'il y ait 4 textes dans le calques des vues renommés ainsi : "Texte_PN", "Texte_Repere", "Texte_N_Affaire_Ref" et "Texte_Matiere".

Set oTextePN = oDrawing.Sheets.Item(1).Views.Item(1).Texts.GetItem("Texte_PN") 'Si cette ligne (et/ou les suivantes) renvoie une erreur (Méthode ... failed), c'est qu'il ne trouve pas le texte avec ce nom et cette adresse (numéro de calque et numéro de vue). Revérifie.

Set oTexteRepere = oDrawing.Sheets.Item(1).Views.Item(1).Texts.GetItem("Texte_Repere")

Set oTexteNAffaireRef = oDrawing.Sheets.Item(1).Views.Item(1).Texts.GetItem("Texte_N_Affaire_Ref")

Set oTexteMatiere = oDrawing.Sheets.Item(1).Views.Item(1).Texts.GetItem("Texte_Matiere")

 

For iCalques = 1 To oDrawing.Sheets.Count

For iVues = 3 To oDrawing.Sheets.Item(iCalques).Views.Count 'Je commence à 3 car les vues 1 et 2 sont toujours respectivement "Edition/Calques des vues" et "Edition/Fond de calque" et il n'y a jamais de lien 3D dessus.

Set oVue = oDrawing.Sheets.Item(iCalques).Views.Item(iVues)

oTextePN.Text = oVue.GenerativeBehavior.Document.PartNumber 'A la place de "PartNumber", tu peux mettre l'une des propriétés par défaut d'une Part : "Revision"; "Definition"; "Nomenclature"; "Source"; "DescriptionRef".

oTexteRepere.Text = oVue.GenerativeBehavior.Document.UserRefProperties.Item(1).Value 'Cela impose d'avoir toujours les mêmes "propriétées ajoutées" et dans le même ordre pour toutes tes pièces sinon il faudrait procéder par recherche parmis toutes les "propriétées ajoutées".

oTexteNAffaireRef.Text = oVue.GenerativeBehavior.Document.UserRefProperties.Item(2).Value

oTexteMatiere.Text = oVue.GenerativeBehavior.Document.UserRefProperties.Item(3).Value

Exit For

Next iVues

Next iCalques

End Sub


Je vais essayer vos solution des que possible. je vous remercie pour les tuyaux

salut salut, j'ai essayer vos code malheureusement pour moi j'ai un message d'erreur du au GenerativeBehavior...


si jamais vous avez une idée...

en attendant j'ai essayer de partir dans l'autre sens (du 3D vers le 2D) et la sans grande surprise sa marche pas mal vu que je ne me base pas sur les liens entre les deux mais le nom des fichiers.

voici le code dans le sens 3D vers 2D:
Option Explicit
Sub CATMain()
   
   Dim Drw As DrawingDocument
   Dim DrwSheet As DrawingSheet
   Dim DrwViews As DrawingViews
   Dim DrwView As DrawingView
   Dim PartParent As PartDocument
   Dim Parametre3D As Parameters
   Dim I As Integer
   
   Dim Desi3D As String
   Dim NumAff3D As String
   Dim Rep3D As String
   Dim Indice3D As String
   Dim Quantite3D As String
   Dim Matiere3D As String
   Dim Traitement3D As String
   Dim Debit3D As String
   
   Dim MyParametre As Parameter
   Dim PartDoc As PartDocument
   
   Set PartDoc = CATIA.ActiveDocument
   Set MyParametre = PartDoc.Part.Parameters.Item("Designation")
   Desi3D = MyParametre.ValueAsString
   'MsgBox (Desi3D)
   
   Set MyParametre = PartDoc.Part.Parameters.Item("Indice/ Révision")
   Indice3D = MyParametre.ValueAsString
   'MsgBox (Indice3D)
   
   Set MyParametre = PartDoc.Part.Parameters.Item("Quantité Cons.")
   Quantite3D = MyParametre.ValueAsString
   Set MyParametre = PartDoc.Part.Parameters.Item("Quantité Sym.")
   Quantite3D = Quantite3D + "+" + MyParametre.ValueAsString + "Sym"
   'MsgBox (Quantite3D)
   
   Set MyParametre = PartDoc.Part.Parameters.Item("Repère")
   Rep3D = MyParametre.ValueAsString
   'MsgBox (Rep3D)
   
   Set MyParametre = PartDoc.Part.Parameters.Item("Matière")
   Matiere3D = MyParametre.ValueAsString
   'MsgBox (Matiere3D)
   
   Set MyParametre = PartDoc.Part.Parameters.Item("N°affaire/Ref")
   NumAff3D = MyParametre.ValueAsString
   'MsgBox (NumAff3D)
   
   Set MyParametre = PartDoc.Part.Parameters.Item("Traitement")
   Traitement3D = MyParametre.ValueAsString
   'MsgBox (Traitement3D)
   
   Set MyParametre = PartDoc.Part.Parameters.Item("Débit")
   Debit3D = MyParametre.ValueAsString
   'MsgBox (Debit3D)
   
   Dim specsAndGeomWindow1 As SpecsAndGeomWindow
   Set specsAndGeomWindow1 = CATIA.ActiveWindow
   
   Dim windows1 As Windows
   Set windows1 = CATIA.Windows
   
   Dim specsAndGeomWindow2 As SpecsAndGeomWindow
   Dim NomPart As String
   NomPart = PartDoc.Name
   NomPart = Replace(NomPart, ".CATPart", ".CATDrawing")
   MsgBox (NomPart)
   Set specsAndGeomWindow2 = windows1.Item(NomPart)
   
   specsAndGeomWindow2.Activate
   
   'Debug.Assert True
   
   Set Drw = CATIA.ActiveDocument
   
   Dim parameters11 As Parameters
   Set parameters11 = Drw.Parameters
       
   Dim strParam11 As StrParam
   
   Set strParam11 = parameters11.Item("Détail")
   strParam11.Value = Desi3D
       
   Set strParam11 = parameters11.Item("Num. Affaire")
   strParam11.Value = NumAff3D
       
   Set strParam11 = parameters11.Item("Matière")
   strParam11.Value = Matiere3D
       
   Set strParam11 = parameters11.Item("Traitement")
   strParam11.Value = Traitement3D
       
   Set strParam11 = parameters11.Item("Débit")
   strParam11.Value = Debit3D
       
   Set strParam11 = parameters11.Item("Quantité")
   strParam11.Value = Quantite3D
       
   Set strParam11 = parameters11.Item("Repère")
   strParam11.Value = Rep3D
       
   Set strParam11 = parameters11.Item("Indice")
   strParam11.Value = Indice3D
   
   MsgBox ("Vérifiez avant d'enregistrer")
   
End Sub

maintenant reste plus qu'à aller du 2D au 3D...

L'exemple que tu montres fonctionne bien chez moi.
As-tu essayé aussi de faire fonctionner mon code tel quel pour voir déjà s'il fonctionne aussi chez toi ?
Si j'ai bien compris ce que tu voulais, ce que je te propose permet de remplir un cartouche grâce aux paramètres du 3D via les liens 2D vers 3D.

Désoler de ne pas avoir répondu plus tôt, j'avais "un peu" de boulot (lol) la semaine dernière. oui même avec ton code tel que tu la écrit ca bug...

Pas de soucis.
Quand tu clic sur "Debug", quelle ligne est surlignée en jaune ?
Tes messages d'erreur sont imprécis et variables. Je commence à remettre en doute ton installation du module VBA. Pour écarter cette Hypothèse, à l'occasion, essaye les codes de lumpazepfel et le mien sur d'autres PC.
Difficile d'émettre des hypothèses sans savoir quelle ligne exactement est incriminée par le message d'erreur.

Salut,

Je suis d'accord avec Chyps17 ( même si ça photo de profil fait peur ).

Je suis reparti de ton premier code, il y avait une erreur de déclaration de la variable PartParent.
J'ai simplement rajouter une détection du type de fichier ouvert (comme dans le code de Chyps17) et intégré ma ligne "Set PartParent = Drw.Sheets.Item(1).Views.Item(3).GenerativeBehavior.Document.Parent".
Effectivement Views.Item(3) car 1 et 2 sont les calques des vues et du fond.
Voici le résultat, pas d'erreur chez moi.

Code:

Option Explicit
Sub CATMain()

Dim Drw As DrawingDocument

Dim DrwSheet As DrawingSheet
Dim DrwViews As DrawingViews
Dim DrwView As DrawingView
'Dim PartParent As Documents
Dim PartParent As Document
Dim Parametre3D As Parameters
Dim I As Integer

 '******** Vérifie si le document actif est un CATDrawing

On Error Resume Next
 Set Drw = CATIA.ActiveDocument
  If (Err.Number <> 0) Then
      MsgBox ("Un CATDrawing doit être actif")
      Exit Sub
  End If
  On Error GoTo 0

'Set Drw = CATIA.ActiveDocument
'MsgBox (Drw.Name)

Set DrwSheet = Drw.Sheets.ActiveSheet
'MsgBox (DrwSheet.Name)

Set DrwViews = DrwSheet.Views
Set DrwView = DrwViews.ActiveView
'MsgBox (Drwview.Name)

'Set PartParent = DrwView.GenerativeBehavior.Document.Parent
Set PartParent = Drw.Sheets.Item(1).Views.Item(3).GenerativeBehavior.Document.Parent 'lien de la 1ère projection
If InStr(PartParent.Name, ".CATPart") <> 0 Then

Set Parametre3D = PartParent.Part.Parameters
MsgBox ("c'est une part" & Parametre3D.Count)

Else

Set Parametre3D = PartParent.Product.Parameters.RootParameterSet.DirectParameters
MsgBox ("c'est un product" & Parametre3D.Count)

End If

End Sub


Re salut a tous désoler d'avoir mit autant de temps pour revenir mais on se fait enchainer

La ligne qui est concerné est la suivante:

je vais tacher d'essayer ton code aussi vite que possible lumpazepfel je vous tiens au courant.

merci a tous les deux

bon j'ai essayer ton code lumpazepfel...
j'ai le même message d'erreur que la dernier fois sur la ligne suivante:



j'ai chercher un peu et suivant certain forum cela viendrais du GenerativeBehavior...

bonne journée à tous

Salut,

Vérifie que la référence "CATIA V5 DraftingInterfaces Object Library" soit bien cochée.

Salut,

Ouep, je confirme la référence "CATIA V5 DraftingInterfaces Object Library" est bien cochée.

Si je trouve la cause je vous tiens informé.

Bon confinement à tous

Polo

Salut, ça ne m'étonne pas sinon tu n'aurais pas pu exécuter le programme jusqu'à là ligne jaune.
Tous les codes de cette discussion fonctionnent chez moi et apparemment chez lumpazepfel aussi.
Je t'invite à essayer sur un autre PC pour voir. Si t'en as d'autres de disponibles.
Bon courage.

Bien le bonjour!
Je vais essayer sur un autre PC. En attendant je vous remercie grandement de m'avoir aider.

et je vous tien au courant.

Salut tout le monde
Je viens de faire l'essai car je suis très intéressé par cette macro, et je rencontre le même bug sur la même ligne que PoloDps, as tu trouvé une solution depuis?

Salut à tous,

pour ma part la macro fonctionne toujours.
Le seul moyen de reproduire cette erreur est de lancer la macro avec un CATDrawing qui n'a pas de lien vers un 3D.
Avez vous bien un 3D lié à votre CATDrawing? --> vérifier avec "Edition" & "Liens" .

Ci dessous un petit code qui permet d'afficher tous les liens d'un document CATIA (si ça peut aider)

Code:

'   source https://www.tech-ecke.de/index_quereinstieg.htm?/catscript/externe_links.htm

Sub CATMain()

Set Bauteil = CATIA.ActiveDocument
Set STIEngine = CATIA.GetItem("CAIEngine")
Set STIDBItem = STIEngine.GetStiDBItemFromAnyObject(Bauteil)
Set Verlinkungen = STIDBItem.GetChildren()

Ausgabe = Ausgabe & "Anzahl der Verlinkungen: " & Verlinkungen.Count & Chr(10)
Ausgabe = Ausgabe & "----------------------------------------" & Chr(10)
For N = 1 To Verlinkungen.Count
   Ausgabe = Ausgabe & "Link Nr.: " & N & Chr(10)
   LinkTyp = Verlinkungen.LinkType(N)
   Ausgabe = Ausgabe & "Linktyp: " & LinkTyp & Chr(10)
   Set Verlinkung = Verlinkungen.Item(N)
   Set LinkDokument = Verlinkung.GetDocument
   Ausgabe = Ausgabe & "Verlinktes Dokument: " & LinkDokument.Name & Chr(10)
   Ausgabe = Ausgabe & "Dateipfad: " & LinkDokument.FullName & Chr(10)
   Ausgabe = Ausgabe & "----------------------------------------" & Chr(10)
Next

MsgBox Ausgabe, 64, "Externe Links"

End Sub


Bonjour,

Je me permet de relancer ce sujet.
Je pense comprendre pourquoi certains rencontrent une erreur et pas d'autres.
C'est lorsque la 1ère vue du calque ne renvoie vers aucun 3D, on recherche l'item(3) à chaque fois mais si celui-ci est une vue sans lien 3D alors la macro plante.

Dans mon entreprise il arrive souvent que la 1ère vue soit composée uniquement d'un texte en diagonal pour indiquer que le plan n'est pas validé ou confidentiel.

Il faudrait trouver le moyen de détecter si la vue est composé d'un lien 3D, sinon on passe à la suivante.
Si quelqu'un sait comment faire, je cherche de mon coté.

Flo

J'ai finalement trouvé, la condition pour savoir si la vue à un lien c'est de savoir si elle a été "générée" avec cette fonction : isGenerative.
Le code ci-dessous :

Code:

Dim Drw As DrawingDocument
Dim DrwSheet As DrawingSheet
Dim DrwViews As DrawingViews
Dim DrwView As DrawingView
Dim PartParent As Document
Dim Parametre3D As Parameters
Dim I As Integer

 '******** Vérifie si le document actif est un CATDrawing

On Error Resume Next
 Set Drw = CATIA.ActiveDocument
  If (Err.Number <> 0) Then
      MsgBox ("Un CATDrawing doit être actif")
      Exit Function
  End If
  On Error GoTo 0

Set DrwSheet = Drw.Sheets.ActiveSheet
Set DrwViews = DrwSheet.Views

Compteview = DrwViews.Count
If Compteview <= 2 Then
    MsgBox "pas de vue sur votre 2D"
    Exit Function
End If
Set DrwView = DrwViews.ActiveView

For I = 3 To Compteview
    TestLien = Drw.Sheets.Item(1).Views.Item(I).IsGenerative
        If TestLien = True Then
            Set PartParent = Drw.Sheets.Item(1).Views.Item(I).GenerativeBehavior.Document.Parent 'lien de la 1ère projection
            'Set PartParent = Drw.Sheets.Item(1).Views.Item(3).GenerativeBehavior.Document.Parent 'lien de la 1ère projection
            If InStr(PartParent.Name, ".CATPart") <> 0 Then
                Set Parametre3D = PartParent.Part.Parameters
                MsgBox ("c'est une part" & Parametre3D.Count)
            Else
                Set Parametre3D = PartParent.Product.Parameters.RootParameterSet.DirectParameters
                MsgBox ("c'est un product" & Parametre3D.Count)
            End If
            TextDesc = PartParent.Product.Definition
            TextName = PartParent.Product.Name
            TextRev = PartParent.Product.Revision
            UserForm5.TextBox5 = TextRev
            UserForm5.TextBox40 = TextDesc
            UserForm5.TextBox42 = TextName
        End If
Next