seb72xx

Bonjour, La macro que j'ai envoyé fait exactement ce que tu veux. Elle récupère le contenu de propriétées (par exemple MATERIAL qui est une propriétée personnalisée ajoutée au CATPART) issu du 3D pour les placer dans des zones de texte préalablement nommé correctement dans le drawing. Pour savoir dans quel fichier CATPART sont les propiétés la macro recherche le fichier 3D associé à la la vue principal qui doit avoir été placé auparavant. MATERIAL est une chaine de texte dans le 3D Texte.MATERIAL est le nom de la zone de texte dans le 2D La macro fait simplement un copier de l'un dans l'autre. Cordialement,

Ci dessous une macro (version beta) qui peut vous aider. Il faut nommer les textes correctement. Sub CATMain() '------------------------------------------------ ' Auteur: Sébastien LAUNAY pour ALLIO ' Cette macro permet de mettre à jour des zones de texte nommé dans un drawing ' pour le remplissage automatique du cartouche ' Les informations sont issu de la pièce 3D mis en plan: ' Propriétées défini par l'utilisateur (voir macro "clean.catvba") ' Propriétées compatible avec le package ZAD Airbus ' format, echelle, date, nom de login transformé selon convention ALLIO '------------------------------------------------ On Error Resume Next Dim drawingDocument1 As DrawingDocument Set drawingDocument1 = CATIA.ActiveDocument Dim drawingSheets1 As DrawingSheets Set drawingSheets1 = drawingDocument1.Sheets Dim drawingSheet1 As DrawingSheet Set drawingSheet1 = drawingSheets1.ActiveSheet Dim ProductDrawn As Product Set ProductDrawn = drawingSheets1.Item(1).Views.Item(3).GenerativeBehavior.Document If Err.Number = 0 Then Dim drawingViews1 As DrawingViews Set drawingViews1 = drawingSheet1.Views 'Dim drawingView1 As DrawingView 'Set drawingView1 = drawingViews1.ActiveView Dim drawingView1 As DrawingView Set drawingView1 = drawingViews1.Item(2) Dim parameters1 As Parameters Set parameters1 = ProductDrawn.UserRefProperties Dim drawingTexts1 As DrawingTexts Set drawingTexts1 = drawingView1.Texts '====start================================================= Set drawingText1 = drawingTexts1.GetItem("Texte.référence") drawingText1.Text = ProductDrawn.Name Set drawingText1 = Nothing Set strParam1 = Nothing '====start================================================= Set drawingText1 = drawingTexts1.GetItem("Texte.Description") drawingText1.Text = ProductDrawn.DescriptionRef Set drawingText1 = Nothing Set strParam1 = Nothing '====start================================================= Set strParam1 = parameters1.GetItem("REFERENCE") Set drawingText1 = drawingTexts1.GetItem("Texte.REFERENCE") drawingText1.Text = "" 'Clears text drawingText1.InsertVariable 0, 0, strParam1 Set drawingText1 = Nothing Set strParam1 = Nothing '====start================================================= Set strParam1 = parameters1.GetItem("MATERIAL") Set drawingText1 = drawingTexts1.GetItem("Texte.MATERIAL") drawingText1.Text = "" 'Clears text drawingText1.InsertVariable 0, 0, strParam1 Set drawingText1 = Nothing Set strParam1 = Nothing '====start================================================= Set strParam1 = parameters1.GetItem("STATE") Set drawingText1 = drawingTexts1.GetItem("Texte.STATE") drawingText1.Text = "" 'Clears text drawingText1.InsertVariable 0, 0, strParam1 Set drawingText1 = Nothing Set strParam1 = Nothing '====start================================================= Set strParam1 = parameters1.GetItem("THICKNESS/DIAMETER") Set drawingText1 = drawingTexts1.GetItem("Texte.THICKNESS") drawingText1.Text = "" 'Clears text drawingText1.InsertVariable 0, 0, strParam1 Set drawingText1 = Nothing Set strParam1 = Nothing '====start================================================= Set strParam1 = parameters1.GetItem("OBSERVATIONS") Set drawingText1 = drawingTexts1.GetItem("Texte.OBSERVATIONS") drawingText1.Text = "" 'Clears text drawingText1.InsertVariable 0, 0, strParam1 Set drawingText1 = Nothing Set strParam1 = Nothing '====start================================================= Set strParam1 = parameters1.GetItem("LENGTH") Set drawingText1 = drawingTexts1.GetItem("Texte.LENGHT") drawingText1.Text = "" 'Clears text drawingText1.InsertVariable 0, 0, strParam1 Set drawingText1 = Nothing Set strParam1 = Nothing '====start================================================= Set strParam1 = parameters1.GetItem("WIDTH") Set drawingText1 = drawingTexts1.GetItem("Texte.WIDTH") drawingText1.Text = "" 'Clears text drawingText1.InsertVariable 0, 0, strParam1 Set drawingText1 = Nothing Set strParam1 = Nothing '====start================================================= Set strParam1 = parameters1.GetItem("MASS") Set drawingText1 = drawingTexts1.GetItem("Texte.MASS") drawingText1.Text = "" 'Clears text drawingText1.InsertVariable 0, 0, strParam1 Set drawingText1 = Nothing Set strParam1 = Nothing '====start================================================= Set drawingText1 = drawingTexts1.GetItem("Texte.Date") drawingText1.Text = Format(Date, "dd/mm/yy") Set drawingText1 = Nothing Set strParam1 = Nothing '====start================================================= Set drawingText1 = drawingTexts1.GetItem("Texte.Dessinateur") 'drawingText1.Text = CATIA.SystemService.Environ("LOGNAME") 'If drawingText1.Text = "" Then drawingText1.Text = CATIA.SystemService.Environ("USERNAME") Texttmp1 = CATIA.SystemService.Environ("USERNAME") drawingText1.Text = UCase(Left$(Texttmp1, 2) + Right$(Texttmp1, 1)) Set drawingText1 = Nothing Set strParam1 = Nothing '====start================================================= Set drawingText1 = drawingTexts1.GetItem("Texte.Format") Select Case drawingSheet1.PaperSize Case catPaperA0 drawingText1.Text = "A0" Case catPaperA1 drawingText1.Text = "A1" Case catPaperA2 drawingText1.Text = "A2" Case catPaperA3 drawingText1.Text = "A3" Case catPaperA4 drawingText1.Text = "A4" End Select Set drawingText1 = Nothing Set strParam1 = Nothing '====start================================================= Set drawingText1 = drawingTexts1.GetItem("Texte.Echelle") drawingText1.Text = drawingSheets1.Item(1).Views.Item(3).Scale1 Set drawingText1 = Nothing Set strParam1 = Nothing '========================================== 'a tester pour mettre a jour drawingText1.ModifyVisu End If End Sub