Drawing TitleBlock UserRefProperties Catia Macro
Drawing TitleBlock UserRefProperties Catia Macro
(OP)
Need help retrieving UserRefProperties in the following code: I am able to get the standard product properties just not the user defined properties (Product:Added Properties)
Please advise...
Sub CATMain()
'Check if active document is a CATDrawing
Set CatiaApp = CATIA.Application
On Error Resume Next 'Error Handler in case no file open.
Set CatiaDoc = CatiaApp.ActiveDocument
On Error GoTo 0 ' Error Handler OFF.
'Document is valid
If Not (CatiaDoc Is Nothing) Then
'Get document type
sFileType = TypeName(CatiaDoc)
'Is it a drawing ?
If sFileType = "DrawingDocument" Then
'Here you get the name of the CATPart that you want to get the Parameters
Set windowsopen = CATIA.Windows
Dim docTargetPart as PartDocument
for i = 1 to windowsopen.count
docTargetPart = Catia.Windows.item (i). name
Dim response
response = MsgBox ("Is it the CATPart that you want to get the Parameters ? " & Chr(13) & Chr(13) & docTargetPart, vbYESNO)
If response = vbYES THEN
Dim docTarget as Product
On Error Resume Next
Set docTarget = CATIA.Documents.Item(docTargetPart)
'Set docProp = docTarget.Products.ReferenceProduct.UserRefProperties
If (Err.Number<>0) Then
MsgBox "TargetPart.CATPart not loaded! Open it in CATIA first"
Exit Sub
End If
'Next six lines didn't work
'Dim docProd As Product
'Set docProd = CATIA.ActiveDocument.Product
'Dim prtDoc As Product
'Set prtDoc = docProd.Products.Item(i)
'Dim docUser As Parameters
'Set docUser = prtDoc.ReferenceProduct.UserRefProperties
rev = docTarget.GetItem(1).Revision
prtno = docTarget.GetItem(1).PartNumber
defn = docTarget.GetItem(1).Definition
sht = docTarget.GetItem(1).PartNumber&"_SHT_1"
mat = docTarget.UserRefProperties.GetItem(1).Material_Specification
surf = docProp.GetItem(1).Surface_Area
dscn = docTarget.GetItem(1).DescriptionRef
'Back in CATDrawing, write those parameters
Dim Params As Parameters
Set Params = CATIA.ActiveDocument.Parameters
Dim drw_name As String
Set drw_name = Params.Item ("Part_Title")
drw_name.Value = dscn
Dim drw_rev As String
Set drw_rev = Params.Item ("Revision")
drw_rev.Value = rev
Dim prt_no As String
Set prt_no = Params.Item ("Part_Number")
prt_no.Value = prtno
Dim mat_spec As String
Set mat_spec = Params.Item ("Material_Specification") 'UserRefProperties
mat_spec.Value = mat
Dim date_cu As String
Set date_cu = Params.Item ("Date")
date_cu.Value = defn
Dim surf_ar As String
Set surf_ar = Params.Item ("Surface_Area") 'UserRefProperties
surf_ar.Value = surf
Dim sht_no As String
Set sht_no = Params.Item ("Sheet_No")
sht_no.Value = sht
Thank You...
Please advise...
Sub CATMain()
'Check if active document is a CATDrawing
Set CatiaApp = CATIA.Application
On Error Resume Next 'Error Handler in case no file open.
Set CatiaDoc = CatiaApp.ActiveDocument
On Error GoTo 0 ' Error Handler OFF.
'Document is valid
If Not (CatiaDoc Is Nothing) Then
'Get document type
sFileType = TypeName(CatiaDoc)
'Is it a drawing ?
If sFileType = "DrawingDocument" Then
'Here you get the name of the CATPart that you want to get the Parameters
Set windowsopen = CATIA.Windows
Dim docTargetPart as PartDocument
for i = 1 to windowsopen.count
docTargetPart = Catia.Windows.item (i). name
Dim response
response = MsgBox ("Is it the CATPart that you want to get the Parameters ? " & Chr(13) & Chr(13) & docTargetPart, vbYESNO)
If response = vbYES THEN
Dim docTarget as Product
On Error Resume Next
Set docTarget = CATIA.Documents.Item(docTargetPart)
'Set docProp = docTarget.Products.ReferenceProduct.UserRefProperties
If (Err.Number<>0) Then
MsgBox "TargetPart.CATPart not loaded! Open it in CATIA first"
Exit Sub
End If
'Next six lines didn't work
'Dim docProd As Product
'Set docProd = CATIA.ActiveDocument.Product
'Dim prtDoc As Product
'Set prtDoc = docProd.Products.Item(i)
'Dim docUser As Parameters
'Set docUser = prtDoc.ReferenceProduct.UserRefProperties
rev = docTarget.GetItem(1).Revision
prtno = docTarget.GetItem(1).PartNumber
defn = docTarget.GetItem(1).Definition
sht = docTarget.GetItem(1).PartNumber&"_SHT_1"
mat = docTarget.UserRefProperties.GetItem(1).Material_Specification
surf = docProp.GetItem(1).Surface_Area
dscn = docTarget.GetItem(1).DescriptionRef
'Back in CATDrawing, write those parameters
Dim Params As Parameters
Set Params = CATIA.ActiveDocument.Parameters
Dim drw_name As String
Set drw_name = Params.Item ("Part_Title")
drw_name.Value = dscn
Dim drw_rev As String
Set drw_rev = Params.Item ("Revision")
drw_rev.Value = rev
Dim prt_no As String
Set prt_no = Params.Item ("Part_Number")
prt_no.Value = prtno
Dim mat_spec As String
Set mat_spec = Params.Item ("Material_Specification") 'UserRefProperties
mat_spec.Value = mat
Dim date_cu As String
Set date_cu = Params.Item ("Date")
date_cu.Value = defn
Dim surf_ar As String
Set surf_ar = Params.Item ("Surface_Area") 'UserRefProperties
surf_ar.Value = surf
Dim sht_no As String
Set sht_no = Params.Item ("Sheet_No")
sht_no.Value = sht
Thank You...





RE: Drawing TitleBlock UserRefProperties Catia Macro
you would like to retrieve user parameters, the macro below can do this:
'--------------- MACRO -----------------------
'--------- Extrait Macro Paramètres ----------
'----- JP 2017 -- http://cao-3d-pro.com/------
'------------------------------------------------
Language="VBSCRIPT"
Sub CATMain()
Dim PartValue 'As Variant
Dim NbPartValue 'As Integer
Dim NameParam 'As String
Dim AllParam 'As String
'
dim OPartDocument 'As PartDocument
Set OPartDocument = CATIA.ActiveDocument
'
Dim RefPart 'As String
RefPart = OPartDocument.Product.PartNumber
'
Dim OProduct 'As Product
Set OProduct = OPartDocument.GetItem(RefPart)
'
Dim OParameters 'As Parameters
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)
AllParam = AllParam & Chr(13) & NameParam
next
MsgBox AllParam, vbApplicationModal
End Sub
Another macro that could help you:
http://cao-3d-pro.com/catia-vbs-parametres-de-exce...