Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

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

Catia Macro Script Help - User Defined Propertes 1

Status
Not open for further replies.

cubygt

Aerospace
Feb 10, 2017
10
0
0
US
Please I need help... I have created the following macros; however, they only work if the product or part is opened up in a separate window. I would like to run a single macro that would these and add the defined properties to every product and part in a assembly.

script for product properties:

Sub CATMain()

Set productdoc = CATIA.ActiveDocument
Set product1 = productdoc.Product
Set parameters1 = product1.UserRefProperties
Set strParam1 = parameters1.CreateString("DRAWING NUMBER", "")

strParam1.ValuateFromString product1.Name & "_SHT_1"

End Sub

script for part properties:
Sub CATMain()

Set productdoc = CATIA.ActiveDocument
Set product1 = productdoc.Product
Set partdocument1 = CATIA.ActiveDocument
Set part1 = partdocument1.Part
Set bodies1 = part1.bodies
Set bodyn = bodies1.Item(1)

Set parameters1 = product1.UserRefProperties
Set parameters2 = product1.UserRefProperties

Set strParam1 = parameters1.CreateString("DRAWING NUMBER", "")
Set strParam2 = parameters1.CreateString("MATERIAL/SPECIFICATION", "")

strParam1.ValuateFromString product1.Name & "_SHT_1"
strParam2.ValuateFromString bodyn.Name

End Sub

Thanks...
 
Replies continue below

Recommended for you

you said:
to every product and part in a assembly

so check recursive scripting... you might want to include a test if the part/product is already done (in case you have several instances of a part/product)

Eric N.
indocti discant et ament meminisse periti
 
Hello,
I had to process a macro of this type, the difference with what you want to do, is that I import the parameters from an Excel file, the macro will loop on all the parts contained in an assembly (active assembly In CATIA), it will also loop on all the subassemblies and parts therein, but the parameters will be written that in the parts, to write parameters in the subassembly it will be necessary to add a procedure as explained right here :
PS: the macro is in VBSCRIPT.

'--------------- MACRO -----------------------
'--------- Extrait Macro Paramètres ----------
'----- JP 2017 -- '------------------------------------------------
Language="VBSCRIPT"
Sub CATMain()
Dim ODocument 'As Document
Dim NbLign 'As Integer
Dim numplan 'As String
Dim design 'As String
Dim fichier 'As String
Dim RefPart 'As String
Dim FichierPath 'As String
Dim LigneExcel 'As Integer
'
Dim OProduct 'As Product
Dim OParameters 'As Parameters
'
Dim NouveauDocCatia 'As Documents
Set NouveauDocCatia = CATIA.Documents
'
Dim ODocuments 'As Documents
Set ODocuments = CATIA.Documents
Dim OPartDocument 'As PartDocument
'
Dim OstrParam 'As StrParam
Dim PartValue 'As Variant
Dim NbPartValue 'As Integer
Dim NameParam 'As String
'
Dim Bfichier 'As Boolean
Dim Bnumplan 'As Boolean
Dim Bdesign 'As Boolean
'
LigneExcel = 1
'
Set objExcel = CreateObject("Excel.Application")
Dim objSheet
'
FichierPath =objExcel.GetOpenFilename ("Fichiers Excel (*.xls*),*.xls*")
objExcel.Workbooks.open(FichierPath) 'bon
objExcel.Visible = True
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
NbLign = objExcel.Range("A1:X1").CurrentRegion.Rows.Count
For i = 1 To NbLign
LigneExcel = i + 1
fichier = objSheet.Cells(LigneExcel, 1)
numplan = objSheet.Cells(LigneExcel, 2)
design = objSheet.Cells(LigneExcel, 3)
For Each ODocument In ODocuments
Bfichier = False
Bnumplan = False
Bdesign = False
If (InStr(1, ODocument.Name, "CATProduct") > 0) Then
If ODocument.Name = fichier Then
End If
End If
If (InStr(1, ODocument.Name, "CATPart") > 0) Then
If ODocument.Name = fichier Then
Set OPartDocument = NouveauDocCatia.Item(ODocument.Name)
RefPart = OPartDocument.Product.PartNumber
Set OProduct = OPartDocument.GetItem(RefPart)
Set OParameters = OProduct.UserRefProperties
'
For Each OstrParam In OParameters
PartValue = Split(OstrParam.Name, "\")
NbPartValue = 0
'
For Each Part In PartValue
NbPartValue = NbPartValue + 1
Next
NameParam = PartValue(NbPartValue - 1)
'
If NameParam = "fichier" Then
Bfichier = True
If OstrParam.Value = fichier Then
Else
OstrParam.Value = fichier
End If
End If
'
If NameParam = "num_plan" Then
Bnumplan = True
If OstrParam.Value = numplan Then
Else
OstrParam.Value = numplan
End If
End If
'
If NameParam = "design" Then
Bdesign = True
If OstrParam.Value = design Then
Else
OstrParam.Value = design
End If
End If
Next
'
If Bfichier = False Then
Set OstrParam = OParameters.CreateString("fichier", (objSheet.Cells(LigneExcel, 1)))
End If
'
If Bnumplan = False Then
Set OstrParam = OParameters.CreateString("num_plan", (objSheet.Cells(LigneExcel, 2)))
End If
'
If Bdesign = False Then
Set OstrParam = OParameters.CreateString("design", (objSheet.Cells(LigneExcel, 3)))
End If
Else
End If
End If
next
next
End Sub
 
All, thanks for your input. I have updated my script shown below. The only issues I am having now is skipping over same part and product instances and being able to use the "partbody" name as an property output. Please advise.

Sub CATMain()

Set productdoc = CATIA.ActiveDocument
Set product1 = productdoc.Product
Set parameters1 = product1.UserRefProperties

Set strParam1 = parameters1.CreateString("DRAWING NUMBER", product1.PartNumber & "_SHT_1" )

GetNextNode CATIA.ActiveDocument.Product

End Sub

Sub GetNextNode(oCurrentProduct As Product)

Dim oCurrentTreeNode As Product
Dim StrNomenclature, StrDesignation, StrWindows As String
Dim i As Integer

'Loop through every tree node for the current product
For i = 1 To oCurrentProduct.Products.Count

Set oCurrentTreeNode = oCurrentProduct.Products.Item(i)
Set oparameters = oCurrentTreeNode.ReferenceProduct.UserRefProperties
Set oparameters1 = oCurrentTreeNode.ReferenceProduct.UserRefProperties

StrWindows = oCurrentTreeNode.ReferenceProduct.Parent.FullName
On Error Resume Next

'Determine if the current node is a part, product or component

If Right(StrWindows, 4) = "Part" Then

Set oCurrentTreeNode = oCurrentTreePart.Part
Set myBody = myPart.Bodies
Set bodyn = myBody.Item(1)

msgbox bodyn.Name

Set strOparameters = oparameters.CreateString("DRAWING NUMBER", oCurrentTreeNode.PartNumber & "_SHT_1")

Set strOparameters1 = oparameters.CreateString("MATERIAL/SPECIFICATION", "")


ElseIf IsProduct(oCurrentTreeNode) = True Then

Set strOparameters = oparameters.CreateString("DRAWING NUMBER", "")

strOparameters.ValuateFromString oCurrentTreeNode.PartNumber & "_SHT_1"

Else
'MsgBox oCurrentTreeNode.PartNumber & " is a component"

End If

'if sub-nodes exist below the current tree node, call the sub recursively
If oCurrentTreeNode.Products.Count > 0 Then
GetNextNode oCurrentTreeNode
End If

Next

End Sub
 
Okay I am down to one issue on this macro. Any help is very much appreciated... I am trying to get the partbody name and use in the input for the "MATERIAL/SPECIFICATION" property. See code below. Just to test I have a Msgbox to return the partbody name but It seems no matter what I do it just skips over the code without any errors.


Sub CATMain()

Set productdoc = CATIA.ActiveDocument
Set product1 = productdoc.Product
Set parameters1 = product1.UserRefProperties

Set strParam1 = parameters1.CreateString("DRAWING NUMBER", product1.PartNumber & "_SHT_1" )

GetNextNode CATIA.ActiveDocument.Product

End Sub

Sub GetNextNode(oCurrentProduct As Product)

Dim oCurrentTreeNode As Product
Dim oCurrentTreeNodePart As Part
Dim MBod As Body
Dim StrNomenclature, StrDesignation, StrWindows As String
Dim i As Integer

'Loop through every tree node for the current product
For i = 1 To oCurrentProduct.Products.Count

Set oCurrentTreeNode = oCurrentProduct.Products.Item(i)
Set oParameters = oCurrentTreeNode.ReferenceProduct.UserRefProperties

StrWindows = oCurrentTreeNode.ReferenceProduct.Parent.FullName
On Error Resume Next

'Determine if the current node is a part, product or component

If Right(StrWindows, 4) = "Part" Then
'MsgBox oCurrentTreeNode.PartNumber & " is a part"

While oParameters.Count > 0
oParameters.Remove(1)
Wend

[highlight #FCE94F] Set oCurrentTreeNodePart = CATIA.Document.Add(oCurrentTreeNode).Part
Set MBod = oCurrentTreePart.MainBody
Msgbox MBod.Name[/highlight]

oParameters.CreateString "BOOK FORM INDEX", oCurrentTreeNode.PartNumber & "_SHT_1"
oParameters.CreateString "MATERIAL/SPECIFICATION", ""

ElseIf IsProduct(oCurrentTreeNode) = True Then

While oParameters.Count > 0
oParameters.Remove(1)
Wend

oParameters.CreateString "DRAWING NUMBER", oCurrentTreeNode.PartNumber & "_SHT_1"

Else
'MsgBox oCurrentTreeNode.PartNumber & " is a component"

End If

'if sub-nodes exist below the current tree node, call the sub recursively

If oCurrentTreeNode.Products.Count > 0 Then
GetNextNode oCurrentTreeNode
End If


Next

End Sub
 
Code:
On Error Resume Next

will prevent error message.. that's why

Code:
Set oCurrentTreeNodePart = CATIA.Document.Add(oCurrentTreeNode).Part
is not giving any error (I have the feeling it could) you could replace it with

Code:
Set oCurrentTreeNodePart = oCurrentTreeNode.Part

and then correct the next line

Code:
Set MBod = oCurrentTree[b]Node[/b]Part.MainBody

I am not checking my code so please excuse me if my typing is not correct...





Eric N.
indocti discant et ament meminisse periti
 
Okay I removed the "On Error Resume Next" to debug the issue.

And changed lines below:

Set oCurrentTreeNodePart = oCurrentTreeNode.Part
Set mBody = oCurrentTreeNodePart.MainBody
Msgbox mBody.Name

Now I do get an error "Object doesn't support this property or method:" 'oCurrentTreeNode.Part'. If I put the "On Error Resume Next" back in everything works except these lines. It seems like even though the code loops through all the products and parts it doesn't recognize when it's a part thus not being able to find the partbody name.

Any other suggestions? Again thanks for you response...
 
Figured it out!!! Finally...

Set oCurrentTreeNodePart = oCurrentTreeNode.ReferenceProduct.Parent.Part
Set mBody = oCurrentTreeNodePart.MainBody

Persistence always pays off [bigsmile]

 
Status
Not open for further replies.
Back
Top