1. 首页
  2. 问答
  3. Catia标题栏宏

Catia标题栏宏

2016-06-15 131 views
0

我试图通过读取.xls表中的数据并使用它填充标题栏（零件编号，材料代码，描述，修订版本，日期和时间）来简化Catia V5.21中的标题栏输入。作者等）。我想在我设计的标题栏中做到这一点（而不是在Catia中已经实现的样式）。Catia标题栏宏

我很乐意自己做，但我不知道从哪里开始。有没有人有任何指针或有任何教程让我开始？

来源

2016-06-15 user2882635

+0

首先，你知道VBA，你有没有为catia编写任何宏？ – GisMofx

+0

不适用于Catia，但是我为Excel写了一些 – user2882635

回答

0

尝试首先记录一个宏，当你创建你的新标题块时，这会给你一个想法如何创建线条和文本。之后，您可以开始将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

+0

请记住，在绘制工作台时记录一个宏会产生一个空的“Sub” – GisMofx

+0

！这就是为什么我无处可去，因为我没有参考点开始编写脚本 – user2882635

+0

感谢ferdo，代码运行良好，我可以对其进行修改。还有一个问题：你有没有指示如何阅读零件属性中的文字？ – user2882635

0

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

0

你不能声明同样的事情两次，你会得到一个错误。另一方面，你在哪里宣布了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

相关问题

 相关问题