Option Explicit
Dim CatApp As INFITF.Application
Dim ActiveDoc As INFITF.Document
Dim PrtDoc As MECMOD.PartDocument
Dim ProdDoc As ProductStructureTypeLib.ProductDocument
Dim CatProduct As Product
Dim CatParameters As Variant
Dim sDocType As String
Dim sFilename As String
Dim sProd_PartNo As String
Dim sProd_Rev As String
Dim sProd_Def As String
Dim sProd_Nom As String
Dim sProd_Source As String
Dim sProd_Desc As String
Dim sMy_PartNo As String
Dim sMy_Rev As String
Dim sMy_Def As String
Dim sMy_Nom As String
Dim sMy_MadeBought As String
Dim sMy_Desc As String
'*******************************************
'*** Variables that should be Defined ***
'*******************************************
Const sUPDATE_VALUES = "Catia" 'Catia or MyProperties
Const sMADE_BOUGHT_STYLE = "StraightCopy" 'StraightCopy or MadeBought
'*******************************************
'*******************************************
'*******************************************
Sub CATMain()
Set CatApp = CATIA.Application
On Error Resume Next
Set ActiveDoc = CatApp.ActiveDocument
If (Err <> 0) Then
MsgBox "No File Open. Routine Ending", vbCritical, "MyProperties"
End
End If
On Error GoTo 0
Select Case TypeName(ActiveDoc)
Case "DrawingDocument"
MsgBox "Does not work for Drawing files." & Chr(13) & "Routine ending", vbExclamation, "MyProperties"
End
Case "PartDocument"
Set PrtDoc = CatApp.ActiveDocument
Set CatProduct = PrtDoc.GetItem("")
sDocType = "PART"
sFilename = Left$(ActiveDoc.Name, (InStrRev(ActiveDoc.Name, ".") - 1))
Case "ProductDocument"
Set ProdDoc = CatApp.ActiveDocument
Set CatProduct = ProdDoc.Product
sDocType = "ASSY"
sFilename = Left$(ActiveDoc.Name, (InStrRev(ActiveDoc.Name, ".") - 1))
End Select
Set CatProduct = CatProduct.ReferenceProduct
Set CatParameters = CatProduct.UserRefProperties
sProd_PartNo = CatProduct.PartNumber
sProd_Rev = CatProduct.Revision
sProd_Def = CatProduct.Definition
sProd_Nom = CatProduct.Nomenclature
sProd_Source = CatProduct.Source '0=catProductSourceUnknown, 1=catProductMade, 2=catProductBought
sProd_Desc = CatProduct.DescriptionRef
sMy_PartNo = MyGetProperty("MyPartNumber")
sMy_Rev = MyGetProperty("MyRevision")
sMy_Def = MyGetProperty("MyDefinition")
sMy_Nom = MyGetProperty("MyNom")
sMy_MadeBought = MyGetProperty("MyMadeBought")
sMy_Desc = MyGetProperty("MyDescription")
If (sUPDATE_VALUES = "Catia") Then
'Update Catia Values
CatProduct.PartNumber = sMy_PartNo
CatProduct.Revision = sMy_Rev
CatProduct.Definition = sMy_Def
CatProduct.Nomenclature = sMy_Nom
If (sMADE_BOUGHT_STYLE = "StraightCopy") Then
CatProduct.Source = sMy_MadeBought
ElseIf (sMADE_BOUGHT_STYLE = "MadeBought") Then
Select Case sMy_MadeBought
Case "Made"
CatProduct.Source = catProductMade
Case "Bought"
CatProduct.Source = catProductBought
Case Else
CatProduct.Source = catProductSourceUnknown
End Select
End If
CatProduct.DescriptionRef = sMy_Desc
ElseIf (sUPDATE_VALUES = "MyProperties") Then
'Update MyProperties Values
Call MyModifyProperty("MyPartNumber", sProd_PartNo)
Call MyModifyProperty("MyRevision", sProd_Rev)
Call MyModifyProperty("MyDefinition", sProd_Def)
Call MyModifyProperty("MyNom", sProd_Nom)
If (sMADE_BOUGHT_STYLE = "StraightCopy") Then
Call MyModifyProperty("MyMadeBought", sProd_Source)
ElseIf (sMADE_BOUGHT_STYLE = "MadeBought") Then
Select Case sProd_Source
Case catProductMade '1
Call MyModifyProperty("MyMadeBought", "Made")
Case catProductBought '2
Call MyModifyProperty("MyMadeBought", "Bought")
Case Else 'catProductSourceUnknown '0
Call MyModifyProperty("MyMadeBought", "Unknown")
End Select
End If
Call MyModifyProperty("MyDescription", sProd_Desc)
End If
End Sub
Function MyGetProperty(sProperty As String)
On Error Resume Next
MyGetProperty = CatParameters.Item(CatProduct.Name & "\Properties\" & sProperty).Value
'Error occured if Property doesn't exist
If (Err <> 0) Then
MyGetProperty = ""
Err.Clear
End If
On Error GoTo 0
End Function
Sub MyModifyProperty(sProperty As String, sPropValue As String)
Dim CatParaItem As Variant
On Error Resume Next
Set CatParaItem = CatParameters.Item(CatProduct.Name & "\Properties\" & sProperty)
'Error occured if Property doesn't exist
If (Err.Number <> 0) Then
'Add Property
Set CatParaItem = CatParameters.CreateString(sProperty, "")
CatParaItem.ValuateFromString ""
Err.Clear
End If
On Error GoTo 0
CatParaItem.Value = sPropValue
End Sub