Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations MintJulep on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Drawing Link text to parameter with macro 2

Status
Not open for further replies.
Sort by date Sort by votes
I'm creating the macro to generate the title block and frame of my company. After all of this time working with CATIA, I never had much the need of doing 2D drawing. every time that I need to make some drawings I used a few templates that I have stored, and fill it by and. Now I'm doing something that I really need to make lots of drawings, then I need to do it properly, otherwise I will die fill the title blocks....

So what I have:

In the CATPart file I have a few parameters, that can be used in BOM and in title block of drawing.
1_mslsks.png


In the CATDrawing, i create the need parameters to fill the title block
2_h7wf5r.png


Now when I insert the title block of my company, I want that draws the entire frame and title block, and when creates the several texts of title block. I will also create a copy and past as a result with link, the desired parameters from the CATPart, after I want to create the attribute link to the parameter. Like this I want to have a link between the parameter and title block. If I change a parameter in the catpart the title block will update (at least it's what i'm expecting)
3_itn8pe.png


Please note: I create my drawing template like this, but I don't know if there is an easier way to do it. When I worked with solidworks in the past, I remember that when we insert the part file in the drawing, the drawing recognize all of parameters of the part, In CATIA i Haven't found how to do it.

Thanks






Tiago Figueiredo
Tooling Engineer

Youtube channel:
 
Upvote 0 Downvote
It seems a little bit complicated....

You can avoid creating parameters in drawing, you can read the drawing source (part), get what parameters values you want, back in drawing, set parameters values for what text names you want.

Is true that you will have to run the macro each time you modify some parameters in part.... I don't know if you will find something about attribute link in documentation, I didn't check.

Regards
Fernando

- Romania
- EU
 
Upvote 0 Downvote
Found it :)


Code: 
Dim relations1 As Relations
Set relations1 = DrwDocument.Relations

Dim parameters1 As Parameters
Set parameters1 = DrwDocument.Parameters

Dim strParam1 As StrParam
Set strParam1 = parameters1.Item("Teste")




 Set MyText1 = MyDrawingViews.ActiveView.Texts.Add((""), 100, 100)
     MyText1.TextProperties.Bold = 1
     MyText1.SetFontSize 0, 0, 2

MyText1.InsertVariable 0, 100, strParam1


Now I need to make the next step... Link the parameters from CATPart to CATDrawing... Let's see if I can handle it.

Tiago Figueiredo
Tooling Engineer

Youtube channel:
 
Upvote 0 Downvote
Yes definitely. Now I'm struggling with link the parameters from CATPart to catdrawing. I can do it manually but with macro looks difficult...

There is an way to manage the links of the catdrawing links. What I'm thinking. Manage a template manually create all the needed links, then use this template and then replace all links to the desired part. Is this doable? How can I manage the links via macro?

Tiago Figueiredo
Tooling Engineer

Youtube channel:
 
Upvote 0 Downvote
I create parameters in Catia user part properties. Then macro takes those parameters to a drawing. If this method is suitable for I'll upload a sample

Regards,
Jenia Ladkov
 
Upvote 0 Downvote
Yes I saw, but this don't create a link to the CATPart properties. I was looking for something that is permanently linked. If I change a parameter in CATPart the value updates in catdrawing.

Tiago Figueiredo
Tooling Engineer

Youtube channel:
 
Upvote 0 Downvote
This is how I get part properties
Code: 
'----FILLING PART PROPERTIES----
On Error Resume Next
Dim ProductDrawn
Set ProductDrawn = DrwSheet.Views.Item(3).GenerativeBehavior.Document

'----DRAWING NUMBER----
Dim DrwNo As String
DrwNo = ProductDrawn.ReferenceProduct.UserRefProperties.Item("DRAWING No.").ValueAsString

Set MyTextDrwNo = MyDrawingViews.ActiveView.Texts.Add("DRAWING No.", 246.5, 14)
MyTextDrwNo.Name = "TitleBlock_Text_Title_8"
MyTextDrwNo.SetFontSize 0, 0, 2
MyTextDrwNo.SetFontName 0, 0, "Century Gothic (TrueType)"
MyTextDrwNo.AnchorPosition = catTopLeft
DrwTexts.GetItem("TitleBlock_Text_Title_8").Text = ProductDrawn.ReferenceProduct.UserRefProperties.Item("DRAWING No.").ValueAsString
If (DrwNo <> "") Then
Else
Set MyTextDrwNo = Texts.GetItem("TitleBlock_Text_Title_8")
VariableDrw = InputBox("DRW. No. NOT FOUND! PLEASE ENTER DRAWING NUMBER" & Chr(13) & _
                     " " & Chr(13) & _
                    "GO BACK TO PART PROPERTIES, FILL DRAWING NUMBER AND UPDATE TITLE BLOCK", "DRAWING NUMBER WARRING", "ENTER DRAWING NUMBER")
MyTextDrwNo.Text = VariableDrw
End If

'----DESCRIPTION----
Dim Descr As String
Descr = ProductDrawn.DescriptionRef
Set MyTextDescr = MyDrawingViews.ActiveView.Texts.Add("DESCRIPTION", 263.4, 22)
MyTextDescr.Name = "TitleBlock_Text_Title_2"
MyTextDescr.SetFontSize 0, 0, 3
MyTextDescr.SetFontName 0, 0, "Century Gothic (TrueType)"
MyTextDescr.AnchorPosition = catMiddleCenter

Set MyTextDescrColor = DrwTexts.GetItem("TitleBlock_Text_Title_2")
MyTextDescrColorCol = 97191431
MyTextDescrColor.TextProperties.Color = MyTextDescrColorCol
MyTextDescrColor.TextProperties.Update

DrwTexts.GetItem("TitleBlock_Text_Title_2").Text = ProductDrawn.DescriptionRef
If (Descr <> "") Then
Else
Set MyTextDescr = Texts.GetItem("TitleBlock_Text_Title_2")
VariableDeskr = InputBox("DESCRIPTION NOT FOUND! PLEASE ENTER DESCRIPTION" & Chr(13) & _
                     " " & Chr(13) & _
                    "GO BACK TO PART PROPERTIES, FILL DESCRIPTION AND UPDATE TITLE BLOCK", "DESCRIPTION WARRING", "ENTER DESCRIPTION")
MyTextDescr.Text = VariableDeskr
End If


'----FILE NAME----
Set MyTextFileName = MyDrawingViews.ActiveView.Texts.Add("XXXXXXX", 239.59, 8.88)
MyTextFileName.Name = "TitleBlock_Text_Title_7"
MyTextFileName.SetFontSize 0, 0, 1.3
MyTextFileName.SetFontName 0, 0, "Century Gothic (TrueType)"
MyTextFileName.AnchorPosition = catTopLeft
DrwTexts.GetItem("TitleBlock_Text_Title_7").Text = ProductDrawn.Parent.Name

'----PART NUMBER----
Set MyTextPartNo = MyDrawingViews.ActiveView.Texts.Add("XXXXXXX", 25, 199)
MyTextPartNo.Name = "TitleBlock_Text_EnoviaV5_Effectivity"
MyTextPartNo.SetFontSize 0, 0, 3
MyTextPartNo.SetFontName 0, 0, "Century Gothic (TrueType)"
MyTextPartNo.AnchorPosition = catMiddleLeft
DrwTexts.GetItem("TitleBlock_Text_EnoviaV5_Effectivity").Text = ProductDrawn.PartNumber

'----COLOR PART NUMBER----
Set MyTextPartNoColor = DrwTexts.GetItem("TitleBlock_Text_EnoviaV5_Effectivity")
MyTextPartNoCol = 67150130
MyTextPartNoColor.TextProperties.Color = MyTextPartNoCol
MyTextPartNoColor.TextProperties.Update

'----REVISION----
Dim Rev As String
Rev = ProductDrawn.Revision
Set MyTextRev = MyDrawingViews.ActiveView.Texts.Add("XXX", 287.605, 12.4)
MyTextRev.Name = "TitleBlock_Text_Title_1"
MyTextRev.SetFontSize 0, 0, 1.8
MyTextRev.SetFontName 0, 0, "Century Gothic (TrueType)"
MyTextRev.AnchorPosition = catTopCenter
DrwTexts.GetItem("TitleBlock_Text_Title_1").Text = ProductDrawn.Revision
If (Rev <> "") Then
Else
Set MyTextRev = Texts.GetItem("TitleBlock_Text_Title_1")
VariableRev = InputBox("REVISION NOT FOUND! PLEASE ENTER REVISION" & Chr(13) & _
                     " " & Chr(13) & _
                    "GO BACK TO PART PROPERTIES, FILL REVISION AND UPDATE TITLE BLOCK", "REVISION WARRING", "ENTER REVISION")
MyTextRev.Text = VariableRev
End If

'----MATERIAL----
Dim Material As String
Material = ProductDrawn.ReferenceProduct.UserRefProperties.Item("MATERIAL").ValueAsString

Set MyTextMaterial = MyDrawingViews.ActiveView.Texts.Add("ENTER MATERIAL", 18.181, 40.345)
MyTextMaterial.Name = "TitleBlock_Text_Title_Material"
MyTextMaterial.SetFontSize 0, 0, 2
MyTextMaterial.SetFontName 0, 0, "Century Gothic (TrueType)"
MyTextMaterial.AnchorPosition = catTopLeft

Set MyTextMaterialColor = DrwTexts.GetItem("TitleBlock_Text_Title_Material")
MyTextMaterialColorCol = 67150130
MyTextMaterialColor.TextProperties.Color = MyTextMaterialColorCol
MyTextMaterialColor.TextProperties.Update

DrwTexts.GetItem("TitleBlock_Text_Title_Material").Text = ProductDrawn.ReferenceProduct.UserRefProperties.Item("MATERIAL").ValueAsString
If (Material <> "") Then
Else
Set MyTextMaterial = Texts.GetItem("TitleBlock_Text_Title_Material")
VariableMaterial = InputBox("MATERIAL NOT FOUND! PLEASE ENTER MATERIAL" & Chr(13) & _
                     " " & Chr(13) & _
                    "OR GO BACK TO PART PROPERTIES, FILL MATERIAL AND UPDATE TITLE BLOCK", "MATERIAL WARRING", "ENTER MATERIAL")
MyTextMaterial.Text = VariableMaterial
End If

'----THICKNESS----
Dim Thickness As String
Thickness = ProductDrawn.ReferenceProduct.UserRefProperties.Item("THICKNESS").ValueAsString

Set MyTextThickness = MyDrawingViews.ActiveView.Texts.Add("ENTER THICKNESS", 33.366, 36.863)
MyTextThickness.Name = "TitleBlock_Text_Title_Thickness"
MyTextThickness.SetFontSize 0, 0, 2
MyTextThickness.SetFontName 0, 0, "Century Gothic (TrueType)"
MyTextThickness.AnchorPosition = catTopLeft

Set MyTextThicknessColor = DrwTexts.GetItem("TitleBlock_Text_Title_Thickness")
MyTextThicknessColorCol = 67150130
MyTextThicknessColor.TextProperties.Color = MyTextThicknessColorCol
MyTextThicknessColor.TextProperties.Update

DrwTexts.GetItem("TitleBlock_Text_Title_Thickness").Text = ProductDrawn.ReferenceProduct.UserRefProperties.Item("THICKNESS").ValueAsString
If (Thickness <> "") Then
Else
Set MyTextThickness = Texts.GetItem("TitleBlock_Text_Title_Thickness")
VariableThickness = InputBox("MATERIAL THICKNESS NOT FOUND! PLEASE ENTER MATERIAL THICKNESS" & Chr(13) & _
                     " " & Chr(13) & _
                    "OR GO BACK TO PART PROPERTIES, FILL MATERIAL THICKNESS AND UPDATE TITLE BLOCK", "MATERIAL THICKNESS WARRING", "ENTER MATERIAL THICKNESS")
MyTextThickness.Text = VariableThickness
End If

'----FILE FOR MANUFACTURING----
'Dim FileForMFG As String
FileForMFG = ProductDrawn.ReferenceProduct.UserRefProperties.Item("FILE FOR MANUFACTURING").ValueAsString

Set MyTextFileForMfg = MyDrawingViews.ActiveView.Texts.Add("ENTER FILE FOR MANUFACTURING", 31.18, 10.411)
MyTextFileForMfg.Name = "TitleBlock_Text_Title_FileForMfg"
MyTextFileForMfg.SetFontSize 0, 0, 2
MyTextFileForMfg.SetFontName 0, 0, "Century Gothic (TrueType)"
MyTextFileForMfg.AnchorPosition = catTopLeft

Set MyTextFileForMfgColor = DrwTexts.GetItem("TitleBlock_Text_Title_FileForMfg")
MyTextFileForMfgColorCol = 67150130
MyTextFileForMfgColor.TextProperties.Color = MyTextFileForMfgColorCol
MyTextFileForMfgsColor.TextProperties.Update

DrwTexts.GetItem("TitleBlock_Text_Title_FileForMfg").Text = ProductDrawn.ReferenceProduct.UserRefProperties.Item("FILE FOR MANUFACTURING").ValueAsString
If (FileForMFG <> "") Then
Else
Set MyTextFileForMfg = Texts.GetItem("TitleBlock_Text_Title_FileForMfg")
VariableFileForMfg = InputBox("FILE FOR MANUFACTURING NOT FOUND! PLEASE ENTER FILE FOR MANUFACTURING" & Chr(13) & _
                     " " & Chr(13) & _
                    "OR GO BACK TO PART PROPERTIES, FILL FILE FOR MANUFACTURING AND UPDATE TITLE BLOCK", "FILE FOR MANUFACTURING WARRING", "ENTER FILE FOR MANUFACTURING")
MyTextFileForMfg.Text = VariableFileForMfg
End If
To update drawing you have to run update
Code: 
Private Sub UpdateSheetBtn_Click()
UpdateSheetBtn.BorderStyle = 1
'----GET CATIA----
On Error Resume Next
    Set MyCATIA = GetObject(, "CATIA.Application")
    If Err.Number <> 0 Then
        Set MyCATIA = CreateObject("CATIA.Application")
        MyCATIA.Visible = True
    End If
    On Error GoTo 0
'----CHECK IF ACTIVE DOCUMENT IS A DRAWING DOCUMENT----
If Not (TypeName(MyCATIA.ActiveDocument) = "DrawingDocument") Then
        message = MsgBox("ACTIVE DOCUMENT IS NOT A DRAWING..." & Chr(13) & _
       "OR PRESS CREATE NEW DRAWING DOCUMENT BUTTON AND THEN PRESS CREATE TEXT AGAIN...", vbOKOnly + vbExclamation, "ACTIVE DOCUMENT IS NOT A DRAWING")
       Exit Sub
    End If
'----END---
Dim MyDrawingDoc As DrawingDocument
Set MyDrawingDoc = MyCATIA.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

'----FRAME CREATION----
'----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
Dim selection1    As Selection
Dim Texts         As DrawingTexts
Set DrwDocument = MyCATIA.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
Set Selection = DrwDocument.Selection

'----UPDATE SHEET NUMBERING----
Dim DView As DrawingView
Dim SheetCount As Integer
Dim currentSheet As Integer
Set DrawingDoc = MyCATIA.ActiveDocument
SheetCount = DrawingDoc.Sheets.Count

currentSheet = 1 'initialize sheet number
For Each DrwSheet In MyDrawingDoc.Sheets
UpdatePageNumber DrwSheet, currentSheet, SheetCount
currentSheet = currentSheet + 1
Next

'----UPDATE DRAWING NUMBER----
On Error Resume Next
For Each DrwSheet In MyDrawingDoc.Sheets
UpdateDrw DrwSheet
Next

'----UPDATE REVISION----
On Error Resume Next
For Each DrwSheet In MyDrawingDoc.Sheets
UpdateDrw DrwSheet
Next

'----UPDATE TITLE----
On Error Resume Next
For Each DrwSheet In MyDrawingDoc.Sheets
UpdateDrw DrwSheet
Next

'----UPDATE FILE NAME----
For Each DrwSheet In MyDrawingDoc.Sheets
UpdateFileName DrwSheet
Next

'----UPDATE MATERIAL----
On Error Resume Next
For Each DrwSheet In MyDrawingDoc.Sheets
UpdateMaterial DrwSheet
Next

'----UPDATE MATERIAL THICKNESS----
On Error Resume Next
For Each DrwSheet In MyDrawingDoc.Sheets
UpdateMaterialThickness DrwSheet
Next

'----UPDATE FILE FOR MANUFACTURING----
On Error Resume Next
For Each DrwSheet In MyDrawingDoc.Sheets
UpdateFileForMFG DrwSheet
Next

'----UPDATE PART NUMBER----
On Error Resume Next
For Each DrwSheet In MyDrawingDoc.Sheets
UpdatePartNo DrwSheet
Next

Set drwviews = MyDrawingSheet.Views
drwviews.Item(1).Activate
'TitleBlockUpdatedForm.Show
UpdateSheetBtn.BorderStyle = 0
message = MsgBox("TITLE BLOCK HAS BEEN UPDATED", vbSystemModal + vbOKOnly + vbInformation, "UPDATE TITLE BLOCK")
   
End Sub

Sub UpdateDrw(currentDrawingSheet As DrawingSheet)
'----GET CATIA----
On Error Resume Next
    Set MyCATIA = GetObject(, "CATIA.Application")
    If Err.Number <> 0 Then
        Set MyCATIA = CreateObject("CATIA.Application")
        MyCATIA.Visible = True
    End If
    On Error GoTo 0
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
Dim selection1    As Selection
Dim Texts         As DrawingTexts
Set DrwDocument = MyCATIA.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
Set selection1 = DrwDocument.Selection
Dim ProductDrawn
Set ProductDrawn = DrwSheet.Views.Item(3).GenerativeBehavior.Document
Dim DrwNo As String
DrwNo = ProductDrawn.ReferenceProduct.UserRefProperties.Item("DRAWING No.").ValueAsString

Dim backgroundView As DrawingView
    Dim MyText As DrawingTexts
    'Dim MyText As DrawingText
    Set backgroundView = currentDrawingSheet.Views.Item("Background View")
    Set dTexts = backgroundView.Texts
    
    On Error GoTo CreateNewDrwNo
    Set MyText = dTexts.GetItem("TitleBlock_Text_Sheet_8")
    MyText.Text = TitleBlock_Text_Title_8
    Exit Sub
    
    On Error GoTo CreateNewRev
    Set MyText = dTexts.GetItem("TitleBlock_Text_Title_1")
    MyText.Text = TitleBlock_Text_Title_1
    Exit Sub
       
    On Error GoTo CreateNewTitle
    Set MyText = dTexts.GetItem("TitleBlock_Text_Sheet_2")
    MyText.Text = TitleBlock_Text_Title_2
    Exit Sub

CreateNewDrwNo:
    dTexts.GetItem("TitleBlock_Text_Title_8").Text = ProductDrawn.ReferenceProduct.UserRefProperties.Item("DRAWING No.").ValueAsString

CreateNewRev:
    dTexts.GetItem("TitleBlock_Text_Title_1").Text = ProductDrawn.Revision

CreateNewTitle:
    dTexts.GetItem("TitleBlock_Text_Title_2").Text = ProductDrawn.DescriptionRef
  
End Sub

Regards,
Jenia Ladkov
 
Upvote 0 Downvote
Hello,

Jenia Ladkov Really interesting. At this moment I haven't CATIA with me.

Can you explain me what is this?

'----UPDATE PART NUMBER----
On Error Resume Next
For Each DrwSheet In MyDrawingDoc.Sheets
UpdatePartNo DrwSheet
Next

UpdatePartNo is a catia vba function or is something located in another sub? I don't know this function and the other ones similar to this. Sorry I really need to learn a lot.

I have found a way to do it. Still a lot a work to do. At this moment I'm reading the needed parameters to fill the title block. Updating I think it will be easy. But I would like to do it when we make the drawing update. Probably I will need to create a "Special command" to update the drawing, and at the same time updates the title block.

I still need to work around a revision table.... So much work to do with this, just for a frame and a title block.

Tiago Figueiredo
Tooling Engineer

Youtube channel:
 
Upvote 0 Downvote
Code: 
    'X coordinate
    Dim dX As Integer
    dX = 10
   
    'Y coordinate
    Dim dY As Integer
    dY = 10
   
    'Number of Rows
    Dim dRows As Integer
    dRows = 10
   
    'Number of Columns
    Dim dColumns As Integer
    dColumns = 5
   
    'Row Height
    Dim RowHeight As Integer
    RowHeight = 4
   
    'Column Width
    Dim ColumnWidth As Integer
    ColumnWidth = 10
   
    Dim MyTables As DrawingTables
    Dim MyTable As DrawingTable
      
    Set MyTable = MyDrawingView.Tables.Add(dX, dY, dRows, dColumns, RowHeight, ColumnWidth)

Regards
Fernando

- Romania
- EU
 
Upvote 0 Downvote
UpdatePartNo DrwSheet another sub. I don't like to store part properties as parameters. It's a par property and not parameter.

Regards,
Jenia Ladkov
 
Upvote 0 Downvote
Thanks Jenia it is fair enough. You have had a lot of work with that one.

Ferdo tomorrow I will try to resize the table. Thanks

This macro is almost finished, still a few more things like the revision table. But I 'm loving the result. I see many people working with a pre set file where they locate the frame and title block for the several sizes of papers. This looks good, but when they need to change from an A4 to an A3 it is a hell of a work, or like happens to me when I draw a strip layout, we can have sometimes 3 meters of paper long, and with scales. Adjust the frame and title block was...

Tiago Figueiredo
Tooling Engineer

Youtube channel:
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

A
  • Locked
  • Question Question
CATIA Macro to insert product/part without link
Replies
2
Views
3K
AbhishekChavan
A
J
  • Locked
  • Question Question
CATIA V5 Macro - Material Database CreateAnalysisData() Parameter
Replies
0
Views
2K
jmerhar312
J
J
  • Locked
  • Question Question
CATIA V5 Macro Replace drawing links
Replies
1
Views
3K
Little Cthulhu
Little Cthulhu
Med Che
  • Question Question
How to get the link of a 2D Component Instance from a Drawing Catalog in CATIA VBA?
Replies
3
Views
5K
Little Cthulhu
Little Cthulhu
P
  • Question Question
How Can Delete Product Description With Macro
Replies
2
Views
2K
Proportions
P

Part and Inventory Search

Sponsor

Back
Top