我試圖通過讀取.xls表中的數據並使用它填充標題欄(零件編號,材料代碼,描述,修訂版本,日期和時間)來簡化Catia V5.21中的標題欄輸入。作者等)。我想在我設計的標題欄中做到這一點(而不是在Catia中已經實現的樣式)。Catia標題欄宏
我很樂意自己做,但我不知道從哪裏開始。有沒有人有任何指針或有任何教程讓我開始?
我試圖通過讀取.xls表中的數據並使用它填充標題欄(零件編號,材料代碼,描述,修訂版本,日期和時間)來簡化Catia V5.21中的標題欄輸入。作者等)。我想在我設計的標題欄中做到這一點(而不是在Catia中已經實現的樣式)。Catia標題欄宏
我很樂意自己做,但我不知道從哪裏開始。有沒有人有任何指針或有任何教程讓我開始?
嘗試首先記錄一個宏,當你創建你的新標題塊時,這會給你一個想法如何創建線條和文本。之後,您可以開始將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
請記住,在繪製工作臺時記錄一個宏會產生一個空的「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
你不能聲明同樣的事情兩次,你會得到一個錯誤。另一方面,你在哪裏宣佈了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"
首先,你知道VBA,你有沒有爲catia編寫任何宏? – GisMofx
不適用於Catia,但是我爲Excel寫了一些 – user2882635