Catia標題欄宏

我試圖通過讀取.xls表中的數據並使用它填充標題欄（零件編號，材料代碼，描述，修訂版本，日期和時間）來簡化Catia V5.21中的標題欄輸入。作者等）。我想在我設計的標題欄中做到這一點（而不是在Catia中已經實現的樣式）。Catia標題欄宏

我很樂意自己做，但我不知道從哪裏開始。有沒有人有任何指針或有任何教程讓我開始？

來源

2016-06-15 user2882635

首先，你知道VBA，你有沒有爲catia編寫任何宏？ – GisMofx

不適用於Catia，但是我爲Excel寫了一些 – user2882635

嘗試首先記錄一個宏，當你創建你的新標題塊時，這會給你一個想法如何創建線條和文本。之後，您可以開始將Excel單元格值與CATIA中的文本值進行連接。

好的，同意，編寫代碼時不是用戶友好性最好的:-)。不過，如果我沒記錯的話（因爲現在我沒有CATIA）有些事情是記錄......

 ' ====================================================== 
     ' 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

來源

2016-06-15 18:40:57 ferdo

請記住，在繪製工作臺時記錄一個宏會產生一個空的「Sub」 – GisMofx

！這就是爲什麼我無處可去，因爲我沒有參考點開始編寫腳本 – user2882635

感謝ferdo，代碼運行良好，我可以對其進行修改。還有一個問題：你有沒有指示如何閱讀零件屬性中的文字？ – user2882635

Ferdo，我修改您的代碼，以便它現在從.xlsx文件中讀取數據，並使用它來填寫圖紙上的文本框。現在，我遇到了一些問題： 1.我必須取消激活繪製線條的代碼，因爲我在當前作用域中爲CATIA對象獲取了重複聲明的錯誤。我刪除了代碼後，一切正常。你也許知道會是什麼原因？ 2.我無法使用常規VBA方法更改字體。當我添加在代碼下面註釋的行時，我得到一個錯誤：方法'打開？對象'WorkBooks'失敗。 3.即使關閉了Catia，我也遇到了打開xlsx文件的問題。我以爲這是因爲宏打開文件，但沒有關閉它，我試圖在最後添加close方法，但我也不斷收到錯誤。

代碼：

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

來源

2016-06-20 13:24:17 user2882635

你不能聲明同樣的事情兩次，你會得到一個錯誤。另一方面，你在哪裏宣佈了Excel？有點像波紋管？不要忘了關閉Excel和檢查你的代碼，我已經做了一個關於字體類型的小編輯

' 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"

來源

2016-06-20 19:18:24 ferdo

回答

相關問題