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
Foren auf CAD.de (alle Foren)
| 
