Makro para ejecutar CATScript (Dassault Systemes - PLM Solutions/CATIA V5 Programmierung)

Hallo Bernd!

Danke für den Link, ich wäre perfekt. Ich bewarb mich für das rekursive Makro gibt mir Fehler, aber könnten Sie mir helfen und mir sagen, es funktioniert nicht?

Das ist mein code rekursive:

Code:
Sub CATMain()
'create document object
Dim tmpDoc As Document

Dim EmptyPar()
Dim ScPath
ScPath = "A:\01_CLIENTES\03_PRAE-TRADE\04_Proyectos\02_PLATAFORMA HTP C919\02_PROYECTO\MACROS"
'each opened document should be selected
For Each tmpDoc In CATIA.Documents
'only parts and products should be changed
If InStr(1, tmpDoc.Name, ".CATProduct") > 0 Or InStr(1, tmpDoc.Name, ".CATPart") > 0 Then

'Definition and Nomenclature Property
CATIA.SystemService.ExecuteScript scpath, catScriptLibraryTypeDirectory, "comac_part.CATScript", "CATMain", EmptyPar

End If

Next
End Sub

und das ist der andere makro "comac_part.CATScript"

Code:
Sub CATMain()
Dim PartNa as string
PartNa = "XXXXX"
Dim ID As Integer
ID = 0
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim product1 As Product
Set product1 = partDocument1.GetItem("part_number")

Dim part1 As Part
Set part1 = partDocument1.Part
Dim IDName As String
Set partDocument1 = CATIA.ActiveDocument

Set product1 = partDocument1.GetItem(IDName)

Dim parameters1 As Parameters
Set parameters1 = product1.UserRefProperties

Dim parameterName As String
Dim counter As Integer
Dim counter_1 As Integer

counter = 1
counter_1 = 0
While counter <= parameters1.Count
parameterName = parameters1.Item(counter).Name
If Right(parameterName, Len("Name") + 1) = "\" & "Name" Then
counter_1 = 1

End If
counter = counter + 1
Wend
If counter_1 = 0 Then
ID = 1
Dim parameters21 As Parameters
Set parameters21 = product1.UserRefProperties
Dim strParam21 As StrParam
Set strParam21 = parameters21.CreateString("Name",PartNa)
strParam21.Value = PartNa

Set product1 = product1.ReferenceProduct
End If

counter = 1
counter_1 = 0
While counter <= parameters1.Count
parameterName = parameters1.Item(counter).Name
If Right(parameterName, Len("名称") + 1) = "\" & "名称" Then
counter_1 = 1

End If
counter = counter + 1
Wend
If counter_1 = 0 Then
ID = 1
Dim parameters22 As Parameters
Set parameters22 = product1.UserRefProperties

Set strParam22 = parameters22.CreateString("名称", PartNa)
strParam22.Value = PartNa

Set product1 = product1.ReferenceProduct

End If
counter = 1
counter_1 = 0
While counter <= parameters1.Count
parameterName = parameters1.Item(counter).Name
If Right(parameterName, Len("Copyright Statement") + 1)= "\" & "Copyright Statement" Then
counter_1 = 1

End If
counter = counter + 1
Wend
If counter_1 = 0 Then
ID = 1
Set parameters1 = product1.UserRefProperties
Dim strParam1 As StrParam
Set strParam1 = parameters1.CreateString("Copyright Statement", "")
strParam1.ValuateFromString ""
Set product1 = product1.ReferenceProduct
Dim arrayOfVariantOfBSTR1(0)
arrayOfVariantOfBSTR1(0) = "THE INFORMATION CONTAINED HEREIN IS PROPERTY ."
Set strParam1Variant = strParam1
strParam1Variant.SetEnumerateValues arrayOfVariantOfBSTR1
strParam1.Value = "THE INFORMATION CONTAINED HEREIN IS PROPERTY."
End If

counter = 1
counter_1 = 0
While counter <= parameters1.Count
parameterName = parameters1.Item(counter).Name
If Right(parameterName, Len("Review Info.") + 1) = "\" & "Review Info." Then
counter_1 = 1

End If
counter = counter + 1
Wend
If counter_1 = 0 Then
ID = 1
Dim parameters2 As Parameters
Set parameters2 = product1.UserRefProperties
Dim strParam2 As StrParam
Set strParam2 = parameters2.CreateString("Review Info.", "")
strParam2.ValuateFromString ""
Set product1 = product1.ReferenceProduct
End If

counter = 1
counter_1 = 0
While counter <= parameters1.Count
parameterName = parameters1.Item(counter).Name
If Right(parameterName, Len("Symmetry") + 1) = "\" & "Symmetry" Then
counter_1 = 1

End If
counter = counter + 1
Wend
If counter_1 = 0 Then
ID = 1
Dim parameters4 As Parameters
Set parameters4 = product1.UserRefProperties
Dim strParam4 As StrParam
Set strParam4 = parameters4.CreateString("Symmetry", "")
strParam4.ValuateFromString ""
Set product1 = product1.ReferenceProduct
End If

counter = 1
counter_1 = 0
While counter <= parameters1.Count
parameterName = parameters1.Item(counter).Name
If Right(parameterName, Len("T Revision") + 1) = "\" & "T Revision" Then
counter_1 = 1

End If
counter = counter + 1
Wend
If counter_1 = 0 Then
ID = 1
Dim parameters99 As Parameters
Set parameters99 = product1.UserRefProperties
Dim strParam99 As StrParam
Set strParam99 = parameters99.CreateString("T Revision", "")
strParam99.ValuateFromString ""
Set product1 = product1.ReferenceProduct
End If
Set product1 = product1.ReferenceProduct
Set product1 = product1.ReferenceProduct
Set product1 = product1.ReferenceProduct
Set product1 = product1.ReferenceProduct
Set product1 = product1.ReferenceProduct
Set product1 = product1.ReferenceProduct
Set part1 = partDocument1.Part
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

counter = 1
counter_1 = 0
While counter <= hybridBodies1.Count
If hybridBodies1.Item(counter).Name = "Geometry Sets" Then
counter_1 = 1

End If
counter = counter + 1
Wend
If counter_1 = 0 Then
ID = 1
Set hybridBody1 = hybridBodies1.Add()
hybridBody1.Name = "Geometry Sets"
part1.Update
End If

counter = 1
counter_1 = 0
While counter <= hybridBodies1.Count
If hybridBodies1.Item(counter).Name = "Material Info." Then
counter_1 = 1

End If
counter = counter + 1
Wend
If counter_1 = 0 Then
ID = 1
Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies1.Add()
hybridBody2.Name = "Material Info."
part1.Update
Set partDocument1 = CATIA.ActiveDocument

Set part1 = partDocument1.Part
Dim parameters7 As Parameters
Set parameters7 = part1.Parameters
Dim strParam7 As StrParam
Set strParam7 = parameters7.CreateString("", "")
strParam7.Rename "Material No."
Dim parameters9 As Parameters
Set parameters9 = part1.Parameters
Dim strParam9 As StrParam
Set strParam9 = parameters9.CreateString("", "")
strParam9.Rename "Material Criterion"
Dim parameters10 As Parameters
Set parameters10 = part1.Parameters
Dim strParam10 As StrParam
Set strParam10 = parameters10.CreateString("", "")
strParam10.Rename "Material Size"
part1.Update
part1.Update
part1.Update
part1.Update

Set partDocument1 = CATIA.ActiveDocument
Dim selection1 As Selection
Set selection1 = partDocument1.Selection
selection1.Clear
Set part1 = partDocument1.Part
Set parameters10 = part1.Parameters
Set strParam10 = parameters10.Item("Material No.")
selection1.Add strParam10

Set parameters8 = part1.Parameters

Set strParam8 = parameters8.Item("Material Criterion")
selection1.Add strParam8

Set parameters7 = part1.Parameters
Set strParam7 = parameters7.Item("Material Size")
selection1.Add strParam7

selection1.Cut
Set partDocument1 = CATIA.ActiveDocument
Dim selection2 As Selection
Set selection2 = partDocument1.Selection
selection2.Clear

Set hybridBodies1 = part1.HybridBodies

Set hybridBody1 = hybridBodies1.Item("Material Info.")
selection2.Add hybridBody1
selection2.Paste
part1.Update
part1.Update
End If
part1.Update
part1.Update

If ID = 0 Then

If MsgBox("请勿重复运行！", vbYes) = vbYes Then

Set product1 = product1.ReferenceProduct
Set product1 = product1.ReferenceProduct
Set product1 = product1.ReferenceProduct
Set product1 = product1.ReferenceProduct
Set product1 = product1.ReferenceProduct
Set product1 = product1.ReferenceProduct

End If

Else
Set partDocument1 = CATIA.ActiveDocument

Set part1 = partDocument1.Part
Dim axisSystems1 As AxisSystems
Set axisSystems1 = part1.AxisSystems
Dim axisSystem1 As AxisSystem
Set axisSystem1 = axisSystems1.Add()
axisSystem1.OriginType = catAxisSystemOriginByCoordinates
Dim arrayOfVariantOfDouble1(2)
arrayOfVariantOfDouble1(0) = 0.000000
arrayOfVariantOfDouble1(1) = 0.000000
arrayOfVariantOfDouble1(2) = 0.000000
axisSystem1.PutOrigin arrayOfVariantOfDouble1
axisSystem1.XAxisType = catAxisSystemAxisByCoordinates
Dim arrayOfVariantOfDouble2(2)
arrayOfVariantOfDouble2(0) = 1.000000
arrayOfVariantOfDouble2(1) = 0.000000
arrayOfVariantOfDouble2(2) = 0.000000
axisSystem1.PutXAxis arrayOfVariantOfDouble2
axisSystem1.YAxisType = catAxisSystemAxisByCoordinates
Dim arrayOfVariantOfDouble3(2)
arrayOfVariantOfDouble3(0) = 0.000000
arrayOfVariantOfDouble3(1) = 1.000000
arrayOfVariantOfDouble3(2) = 0.000000
axisSystem1.PutYAxis arrayOfVariantOfDouble3
axisSystem1.ZAxisType = catAxisSystemAxisByCoordinates
Dim arrayOfVariantOfDouble4(2)
arrayOfVariantOfDouble4(0) = 0.000000
arrayOfVariantOfDouble4(1) = 0.000000
arrayOfVariantOfDouble4(2) = 1.000000
axisSystem1.PutZAxis arrayOfVariantOfDouble4
part1.UpdateObject axisSystem1
axisSystem1.IsCurrent = True
part1.Update
Set product1 = product1.ReferenceProduct
Set product1 = product1.ReferenceProduct
End If
End Sub

Vielen Dank

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP