Macro de bloc de titre Catia

Question

J'essaie de simplifier l'entrée de bloc de titre dans Catia V5.21 en lisant les données d'une table .xls et en l'utilisant pour remplir le cartouche (numéro de pièce, code article, description, révision, date, auteur etc). Je veux le faire dans un cartouche que je concevrai (pas les styles déjà implémentés dans Catia). J'aimerais vraiment le faire moi-même mais je n'ai aucune idée par où commencer. Est-ce que quelqu'un a des pointeurs ou y at-il des tutoriels pour me lancer?

Answer 1

Essayez d'abord d'enregistrer une macro lorsque vous créez votre nouveau cartouche, cela vous donnera une idée de la façon dont les lignes et le texte sont créés. Après cela, vous pouvez commencer à connecter des valeurs de cellules Excel avec des valeurs de texte dans CATIA. OK, d'accord, le dessin n'est pas le plus convivial lors du codage :-). Pourtant, si je me souviens bien (parce que maintenant je n'ai pas CATIA) certaines choses sont enregistrées ...

 ' ====================================================== 
     ' Purpose: Macro will activate the backgroud view in an active CATIA drawing (A4 sheet) and will draw a title block 
     ' Usage: 1 - A CATDrawing must be active 
     '   2 - Run macro 
     ' Author: ferdo (Disclaimer: You use this code at your own risk) 
     ' ====================================================== 
     Language="VBSCRIPT" 

     ' made as example by ferdo for auxcad.com 

     Sub CATMain() 

     Dim CATIA As Object 
     Set CATIA = GetObject(, "CATIA.Application") 

     Dim MyDrawingDoc As DrawingDocument 
     Set MyDrawingDoc = CATIA.ActiveDocument 

     Dim MyDrawingSheets As DrawingSheets 
     Set MyDrawingSheets = MyDrawingDoc.Sheets 

     Dim MyDrawingSheet As DrawingSheet 
     Set MyDrawingSheet = MyDrawingSheets.ActiveSheet 

     Dim MyDrawingViews As DrawingViews 
     Set MyDrawingViews = MyDrawingSheet.Views 

     Dim drwviews As DrawingViews 'make background view active 
     Set drwviews = MyDrawingSheet.Views 
     drwviews.Item("Background View").Activate 

     'Set myText.... As DrawingText - adding texts 
     Set myText = MyDrawingViews.ActiveView.Texts.Add ("Dibujado", 22, 38) 'coordinates x=22, y=38 of left bottom corner of the text location 
     Set myText1 = MyDrawingViews.ActiveView.Texts.Add ("Corregido", 22, 31) 
     Set myText2 = MyDrawingViews.ActiveView.Texts.Add ("Fecha", 57, 46) 
     Set myText3 = MyDrawingViews.ActiveView.Texts.Add ("DD-mm-08", 57, 38) 
     Set myText4 = MyDrawingViews.ActiveView.Texts.Add ("DD-mm-08", 57, 31) 
     Set myText5 = MyDrawingViews.ActiveView.Texts.Add ("Nombre", 87, 46) 
     Set myText6 = MyDrawingViews.ActiveView.Texts.Add ("Jefatura", 87, 38) 
     Set myText7 = MyDrawingViews.ActiveView.Texts.Add ("Delineante", 87, 31) 
     Set myText8 = MyDrawingViews.ActiveView.Texts.Add ("Empresa S.A.", 159, 40) 
     Set myText9 = MyDrawingViews.ActiveView.Texts.Add ("C/laredo 8, 2B", 159, 32) 

     Set myText13 = MyDrawingViews.ActiveView.Texts.Add ("Escalas:", 22, 23) 
     Set myText14 = MyDrawingViews.ActiveView.Texts.Add ("1/X", 22, 17) 
     Set myText15 = MyDrawingViews.ActiveView.Texts.Add ("1/X", 22, 11) 
     Set myText16 = MyDrawingViews.ActiveView.Texts.Add ("Firma", 128, 38) 

     Dim iFortSize1 As Double 'font text size 
     iFontSize1 = 3.500 
     myText1.SetFontSize 0, 0, 3.500 'iFontSize 

     'next lines with a different size for fonts - 2.5 
     Set myText10 = MyDrawingViews.ActiveView.Texts.Add ("Sustituye a: xxx-08", 155, 22) 
     Set myText11 = MyDrawingViews.ActiveView.Texts.Add ("Sustituido por: xxx-08", 155, 12) 

     Dim iFortSize10 As Double 
     iFontSize10 = 2.500 
     myText10.SetFontSize 0, 0, 2.500 'iFontSize 

     Dim iFortSize11 As Double 
     iFontSize11 = 2.500 
     myText11.SetFontSize 0, 0, 2.500 'iFontSize 

     'next lines with a different size for fonts - 5 
     Set myText12 = MyDrawingViews.ActiveView.Texts.Add ("plano No xxx-08", 70, 18) 

     Dim iFortSize12 As Double 
     iFontSize12 = 5.00 
     myText12.SetFontSize 0, 0, 5.00 'iFontSize 

     'Declarations 

     Dim DrwDocument As DrawingDocument 
     Dim DrwSheets  As DrawingSheets 
     Dim DrwSheet  As DrawingSheet 
     Dim DrwView  As DrawingView 
     Dim DrwTexts  As DrawingTexts 
     Dim Text   As DrawingText 
     Dim Fact   As Factory2D 
     Dim Point   As Point2D 
     Dim Line   As Line2D 
     Dim Cicle   As Circle2D 
     Dim Selection  As Selection 
     Dim GeomElems  As GeometricElements 


      Set DrwDocument = CATIA.ActiveDocument 
      Set DrwSheets = DrwDocument.Sheets 
      Set Selection = DrwDocument.Selection 
      Set DrwSheet = DrwSheets.ActiveSheet 
      Set DrwView  = DrwSheet.Views.ActiveView 
      Set DrwTexts = DrwView.Texts 
      Set Fact  = DrwView.Factory2D 
      Set GeomElems = DrwView.GeometricElements 


     'draw frame bottom line 
      Set Line1 = Fact.CreateLine(20, 5, 205, 5) 'these are the coordinates of the starting point x=20, y=5 of the line and end point of the line x=205, y=5 
      Line1.Name = "Line1" 
      CATIA.ActiveDocument.Selection.VisProperties.SetRealWidth 3,1 
      CATIA.ActiveDocument.Selection.Clear 

     'draw frame upper line 
      Set Line2 = Fact.CreateLine(20, 292, 205, 292) 
      Line2.Name = "Line2" 
      CATIA.ActiveDocument.Selection.VisProperties.SetRealWidth 3,1 
      CATIA.ActiveDocument.Selection.Clear 

     'draw a thin line 
      Set Line3 = Fact.CreateLine(20, 40, 120, 40) 
      Line3.Name = "Line3" 
      CATIA.ActiveDocument.Selection.Add Line3 
      Set visProperties1 = CATIA.ActiveDocument.Selection.VisProperties 
      visProperties1.SetRealLineType 1,0.2 
      Set visProperties1 = CATIA.ActiveDocument.Selection.VisProperties 
      visProperties1.SetRealWidth 1,0.2 


      CATIA.ActiveDocument.Selection.Clear 
     ' You can continue to draw the rest of the lines and try other settings... 


     End Sub 

Answer 2

Ferdo, j'ai modifié votre code de sorte qu'il se lit maintenant des données à partir d'un fichier .xlsx et l'utilise pour remplissez les zones de texte sur le dessin. Maintenant j'ai quelques problèmes: 1. J'ai dû désactiver le code pour dessiner des lignes car j'ai eu une erreur pour la déclaration en double dans la portée actuelle pour l'objet CATIA. Après avoir enlevé le code, tout a bien fonctionné. Savez-vous peut-être quelle serait la cause? 2. Je ne peux pas changer la police en utilisant les méthodes VBA normales. Lorsque j'ajoute la ligne qui est commentée dans le code ci-dessous, j'obtiens une erreur: Méthode 'Open? de l'objet 'WorkBooks' a échoué. 3. J'ai des problèmes avec l'ouverture du fichier xlsx même lorsque je ferme Catia. Je pensais que c'était parce que la macro ouvre le fichier mais ne le ferme pas et j'ai essayé d'ajouter la méthode de fermeture à la fin, mais je continue aussi à obtenir des erreurs.

code:

Sub CATMain() 
    'Define the variables 
    Dim GetData As Range 'range for finding cells in workbook 
    Dim PartNum As String 'variable for search key 
    Dim MyPath As String 'variable for workbook file path 
    Dim MyWB As String  'variable for workbook file name 

    Dim Datum As Date 

    Dim FontSize1 As Double 'font text size 
    Dim FontSize2 As Double 
    Dim FontSize3 As Double 

    Dim FontName1 As Double 

    'The text for which to search 
    PartNum = InputBox(prompt:="Enter Filter Part Number", Title:="Filter Part Number") 

    'The path to the workbook 
    MyPath = "C:\New folder\" 

    'The name of the workbook in which to search. 
    MyWB = "Podatki.xlsx" 

    'Turn off screen updating, and then open the target workbook. 
    Application.ScreenUpdating = False 
    Workbooks.Open Filename:=MyPath & MyWB 

    'Search for specified text 
    Set GetData = ActiveSheet.Cells.Find(PartNum) 


    Dim CATIA As Object 
    Set CATIA = GetObject(, "CATIA.Application") 

    Dim MyDrawingDoc As DrawingDocument 
    Set MyDrawingDoc = CATIA.ActiveDocument 

    Dim MyDrawingSheets As DrawingSheets 
    Set MyDrawingSheets = MyDrawingDoc.Sheets 

    Dim MyDrawingSheet As DrawingSheet 
    Set MyDrawingSheet = MyDrawingSheets.ActiveSheet 

    Dim MyDrawingViews As DrawingViews 
    Set MyDrawingViews = MyDrawingSheet.Views 

    Dim drwviews As DrawingViews 'make background view active 
    Set drwviews = MyDrawingSheet.Views 
    drwviews.Item("Background View").Activate 



    'Set myText.... As DrawingText - adding texts 
    Set myText1 = MyDrawingViews.ActiveView.Texts.Add(GetData.Value, 376, 19) 
    Set myText2 = MyDrawingViews.ActiveView.Texts.Add(GetData.Offset(0, -1), 374, 24) 
    Set myText3 = MyDrawingViews.ActiveView.Texts.Add(GetData.Offset(0, 1), 376, 14) 
    Set myText4 = MyDrawingViews.ActiveView.Texts.Add(Date, 357, 34) 
    Set myText5 = MyDrawingViews.ActiveView.Texts.Add(Date, 357, 39) 
    Set myText6 = MyDrawingViews.ActiveView.Texts.Add(Date, 357, 44) 
    Set myText7 = MyDrawingViews.ActiveView.Texts.Add("Surname Name", 374, 44) 


    FontSize1 = 2.5 
    FontSize2 = 2 
    FONTNAME = "Arial (TrueType)" ''if I remember correctly, here is only Arial without TrueType 
    myText1.SetFontSize 0, 0, FontSize1 
    myText2.SetFontSize 0, 0, FontSize1 
    myText3.SetFontSize 0, 0, FontSize1 
    myText4.SetFontSize 0, 0, FontSize2 
    myText5.SetFontSize 0, 0, FontSize2 
    myText6.SetFontSize 0, 0, FontSize2 
    myText7.SetFontSize 0, 0, FontSize2 

    'myText1.SetFontName 0, 0, FontName1 


    'Workbooks(MyPath & MyWB).Close SaveChanges:=False 
    'Workbooks.Close Filename:=MyPath & MyWB 

End Sub 

Answer 3

Vous ne pouvez pas déclarer même chose deux fois, vous obtiendrez une erreur. D'autre part, où avez-vous déclaré Excel? Quelque chose comme beugler? N'oubliez pas de fermer Excel et vérifier votre code, j'ai fait une petite modification concernant le type de police

' Open an Excel File from CATIA 

Dim OutPath 
Dim OutIndex 
Dim wbk As Excel.Workbook 
Dim xlApp As Excel.Application 
OutPath = "C:\temp\" 
OutIndex = "YourFile.xls"