Code:
Sub CATMain()Dim documents1 As Documents
Set documents1 = CATIA.Documents
Dim partDocument1 As PartDocument
Set partDocument1 = documents1.Item("Kabelkanal.CATPart")
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
'Allgemein Ende -------------------------------------------------------------------------------
Dim parameters1 As Parameters
Set parameters1 = part1.Parameters
Dim hybridShapeSurfaceExplicit1 As HybridShapeSurfaceExplicit
Set hybridShapeSurfaceExplicit1 = parameters1.Item("Surface____1")
Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(hybridShapeSurfaceExplicit1)
Dim parameters2 As Parameters
Set parameters2 = part1.Parameters
Dim hybridShapeSurfaceExplicit2 As HybridShapeSurfaceExplicit
Set hybridShapeSurfaceExplicit2 = parameters2.Item("Surface_1")
Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(hybridShapeSurfaceExplicit2)
Dim hybridShapeIntersection1 As HybridShapeIntersection
Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(reference1, reference2)
hybridShapeIntersection1.PointType = 0
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Schnitte_01")
hybridBody1.AppendHybridShape hybridShapeIntersection1
part1.InWorkObject = hybridShapeIntersection1
part1.Update
'Schnitt 1 Ende --------------------------------------------------------------------------------
'Schnitt 2 Anfang ------------------------------------------------------------------------------
Dim parameters3 As Parameters
Set parameters3 = part1.Parameters
Dim hybridShapeSurfaceExplicit3 As HybridShapeSurfaceExplicit
Set hybridShapeSurfaceExplicit3 = parameters3.Item("Surface____2")
Dim reference3 As Reference
Set reference3 = part1.CreateReferenceFromObject(hybridShapeSurfaceExplicit3)
Dim reference4 As Reference
Set reference4 = part1.CreateReferenceFromObject(hybridShapeSurfaceExplicit2)
Dim hybridShapeIntersection2 As HybridShapeIntersection
Set hybridShapeIntersection2 = hybridShapeFactory1.AddNewIntersection(reference3, reference4)
hybridShapeIntersection2.PointType = 0
hybridBody1.AppendHybridShape hybridShapeIntersection2
part1.InWorkObject = hybridShapeIntersection2
part1.Update
'Schnitt 2 Ende --------------------------------------------------------------------------------
'Schnitt 3 Anfang ------------------------------------------------------------------------------
Dim parameters4 As Parameters
Set parameters4 = part1.Parameters
Dim hybridShapeSurfaceExplicit4 As HybridShapeSurfaceExplicit
Set hybridShapeSurfaceExplicit4 = parameters4.Item("Surface____3")
Dim reference5 As Reference
Set reference5 = part1.CreateReferenceFromObject(hybridShapeSurfaceExplicit4)
Dim reference6 As Reference
Set reference6 = part1.CreateReferenceFromObject(hybridShapeSurfaceExplicit2)
Dim hybridShapeIntersection3 As HybridShapeIntersection
Set hybridShapeIntersection3 = hybridShapeFactory1.AddNewIntersection(reference5, reference6)
hybridShapeIntersection3.PointType = 0
hybridBody1.AppendHybridShape hybridShapeIntersection3
part1.InWorkObject = hybridShapeIntersection3
part1.Update
'Schnitt 3 Ende --------------------------------------------------------------------------------
End Sub
Viele Grüße
Micha