Code:
'------------------------------------------------------------------------
'Create the Starting Geometry
'------------------------------------------------------------------------Sub GeometryStart(PTab() As Double, Nom As String, B As Double) 'PTab()=geometric parameters'
'Get CATIA and create bodies
Dim PtDoc, MeineKoerper, HBodies, Parameter As Object
Set PtDoc = GetCATIAPartDocument
Set MeineKoerper = PtDoc.Part.Bodies
Set HBodies = PtDoc.Part.HybridBodies
Dim Koerper As Object
Set Koerper = MeineKoerper.Add()
Koerper.Name = Nom
'Create Abschnitte and Schnitte
Set FA = HBodies.Add()
FA.Name = Nom & "_Abschnitt"
For i = 1 To 2 * PTab(0, 0)
Set FS = FA.HybridBodies.Add()
FS.Name = Nom & "_Schnitt_" & i
'Create the origin points
Dim Punkt As Object
Set Punkt = PtDoc.Part.HybridShapeFactory.AddNewPointCoord(PTab(i, 1), PTab(i, 2), PTab(i, 3))
Punkt.Name = "Ursprung_Schnitt_" & i
FS.AppendHybridShape Punkt
'Create the Y Lines
Dim Ref1 As Object
Dim Richtung, LinieY As Object
Set Ref1 = PtDoc.Part.CreateReferenceFromObject(Punkt)
Set Richtung = PtDoc.Part.HybridShapeFactory.AddNewDirectionByCoord(0, 10, 0)
Set LinieY = PtDoc.Part.HybridShapeFactory.AddNewLinePtDir(Ref1, Richtung, 0, 300, False)
LinieY.Name = Nom & "_LinieY_Schnitt_" & i
FS.AppendHybridShape LinieY
'Create the "Winkel-Ebene" and the perpendicular-Ebene
Dim RefY, UrsprungsElemente, EbeneZX, Ref5, EbeneXY, Ref3, Ebene2, Ref4, Ebene3 As Object
Set RefY = PtDoc.Part.CreateReferenceFromObject(LinieY)
Set UrsprungsElemente = PtDoc.Part.OriginElements
Set EbeneXY = UrsprungsElemente.PlaneXY
Set Ref3 = PtDoc.Part.CreateReferenceFromObject(EbeneXY)
Set Ebene2 = PtDoc.Part.HybridShapeFactory.AddNewPlaneAngle(Ref3, RefY, PTab(i, 5), 0)
FS.AppendHybridShape Ebene2
Set Ref4 = PtDoc.Part.CreateReferenceFromObject(Ebene2)
Set Ebene3 = PtDoc.Part.HybridShapeFactory.AddNewPlaneAngle(Ref4, RefY, 90, 0)
FS.AppendHybridShape Ebene3
Set EbeneZX = UrsprungsElemente.PlaneZX
Set Ref5 = PtDoc.Part.CreateReferenceFromObject(EbeneZX)
'Create the X Lines
Dim Richtung2, LinieX As Object
Set Richtung2 = PtDoc.Part.HybridShapeFactory.AddNewDirection(Ebene3)
Set LinieX = PtDoc.Part.HybridShapeFactory.AddNewLinePtDir(Ref1, Richtung2, 0, 300, False)
LinieX.Name = Nom & "_LinieX_Schnitt_" & i
FS.AppendHybridShape LinieX
'Create the Z Lines
Dim Richtung3, LinieZ As Object
Set Richtung3 = PtDoc.Part.HybridShapeFactory.AddNewDirection(Ebene2)
Set LinieZ = PtDoc.Part.HybridShapeFactory.AddNewLinePtDir(Ref1, Richtung3, 0, 300, False)
LinieZ.Name = Nom & "_LinieZ_Schnitt_" & i
FS.AppendHybridShape LinieZ
'Create The AxisSystem
PtDoc.Part.Update
Dim Axis, RefX, RefZ, Rot As Object
Set Axis = PtDoc.Part.AxisSystems.Add
Axis.Name = Nom & "_Axis_" & i
Axis.Type = catAxisSystemAxisRotation
Axis.OriginType = catAxisSystemOriginByPoint '0
Axis.OriginPoint = Ref1
Axis.XAxisType = catAxisSystemAxisSameDirection '0
Set RefX = PtDoc.Part.CreateReferenceFromObject(LinieX)
Axis.XAxisDirection = RefX
Axis.AxisRotationReference = Ref5
''Choose between ZY-Ebene or XY Ebene To create the profiles
' If B = 1 Then
' Axis.YAxisDirection = RefY
' Axis.ZAxisDirection = RefZ
' ElseIf B = 2 Then
' Axis.YAxisDirection = RefZ
' Axis.ZAxisDirection = RefY
' End If
'
PtDoc.Part.UpdateObject Axis
Next
'Create geometrical set for profile geometry
Dim FA1, FS1 As Object
For j = 1 To 2 * PTab(0, 0)
Set FA1 = HBodies.Item(Nom & "_Abschnitt")
Set FS1 = FA1.HybridBodies.Item(Nom & "_Schnitt_" & j)
Set Hbody = FS1.HybridBodies.Add()
Hbody.Name = "Profil_Schnitt_" & j
Next j
End Sub