Code:
Sub CATMain()Dim EnableSelectionFor(0)
Dim EnableSelectionFor1(0)
'-------------- Geo Set Selektion und umbenennen
EnableSelectionFor (0) = "HybridBody"
Set sSel = CATIA.ActiveDocument.Selection
sSel.Clear
Call MsgBox("Bitte Geometrisches Set der Flaeche auswaehlen!")
UserSelection = sSel.SelectElement2(EnableSelectionFor, "GeoSet waehlen", False)
If UserSelection <> "Normal" Then
MsgBox "Fehler bei der Auswahl"
Exit Sub
Else
Set oHybridShape = sSel.Item(1).Value
' MsgBox (sSel.Item(1).Value.Name)
oHybridShape.Name="SideShield"
End If
'-------------- Flaeche Selektion und umbenennen
EnableSelectionFor1 (0) = "HybridShape"
Set sSel1 = CATIA.ActiveDocument.Selection
sSel1.Clear
Call MsgBox("Bitte Flaeche auswaehlen!")
UserSelection1 = sSel1.SelectElement2(EnableSelectionFor1, "Flaeche waehlen", False)
If UserSelection1 <> "Normal" Then
MsgBox "Fehler bei der Auswahl"
Exit Sub
Else
Set oHybridShape1 = sSel1.Item(1).Value
' MsgBox (sSel1.Item(1).Value.Name)
oHybridShape1.Name="WindowShape"
End If
' -----------------------------------------Auflösung
Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridBodies1 = part1.HybridBodies
Set hybridBody1 = hybridBodies1.Item("SideShield")
Set hybridShapes1 = hybridBody1.HybridShapes
Set hybridShape = hybridShapes1.Item("WindowShape")
'-------------------Finden von MaxX
Set axisSystems1 = part1.AxisSystems
Set axisSystem1 = axisSystems1.Item("Absolute Axis System")
Set reference1 = part1.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(AxisSystem.1;1);None:();Cf11:());Face:(Brp:(AxisSystem.1;3);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPe rmanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", axisSystem1)
Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirection(reference1)
Set reference2 = part1.CreateReferenceFromObject(hybridShape)
Set hybridShapeExtremum1 = hybridShapeFactory1.AddNewExtremum(reference2, hybridShapeDirection1, 1)
hybridShapeExtremum1.Name="MaxX"
Set reference3 = part1.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(AxisSystem.1;3);None:();Cf11:());Face:(Brp:(AxisSystem.1;2);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPe rmanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", axisSystem1)
Set hybridShapeDirection2 = hybridShapeFactory1.AddNewDirection(reference3)
hybridShapeExtremum1.Direction2 = hybridShapeDirection2
hybridShapeExtremum1.ExtremumType2 = 1
hybridBody1.AppendHybridShape hybridShapeExtremum1
part1.InWorkObject = hybridShapeExtremum1
part1.Update
part1.Update
'----------------------Finden von MinX
Set reference3 = part1.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(AxisSystem.1;1);None:();Cf11:());Face:(Brp:(AxisSystem.1;3);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPe rmanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", axisSystem1)
Set hybridShapeDirection2 = hybridShapeFactory1.AddNewDirection(reference3)
Set reference4 = part1.CreateReferenceFromObject(hybridShape)
Set hybridShapeExtremum2 = hybridShapeFactory1.AddNewExtremum(reference4, hybridShapeDirection2, 0)
hybridShapeExtremum2.Name="MinX"
Set reference6 = part1.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(AxisSystem.1;3);None:();Cf11:());Face:(Brp:(AxisSystem.1;2);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPe rmanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", axisSystem1)
Set hybridShapeDirection4 = hybridShapeFactory1.AddNewDirection(reference6)
hybridShapeExtremum2.Direction2 = hybridShapeDirection4
hybridShapeExtremum2.ExtremumType2 = 0
hybridBody1.AppendHybridShape hybridShapeExtremum2
part1.InWorkObject = hybridShapeExtremum2
part1.Update
part1.Update
'----------------------Finden von MaxZ
Set reference5 = part1.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(AxisSystem.1;3);None:();Cf11:());Face:(Brp:(AxisSystem.1;2);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPe rmanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", axisSystem1)
Set hybridShapeDirection3 = hybridShapeFactory1.AddNewDirection(reference5)
Set reference6 = part1.CreateReferenceFromObject(hybridShape)
Set hybridShapeExtremum3 = hybridShapeFactory1.AddNewExtremum(reference6, hybridShapeDirection3, 1)
hybridShapeExtremum3.Name="MaxZ"
Set reference9 = part1.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(AxisSystem.1;1);None:();Cf11:());Face:(Brp:(AxisSystem.1;3);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPe rmanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", axisSystem1)
Set hybridShapeDirection6 = hybridShapeFactory1.AddNewDirection(reference9)
hybridShapeExtremum3.Direction2 = hybridShapeDirection6
hybridShapeExtremum3.ExtremumType2 = 1
hybridBody1.AppendHybridShape hybridShapeExtremum3
part1.InWorkObject = hybridShapeExtremum3
part1.Update
part1.Update
'----------------------Finden von MinZ
Set reference7 = part1.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(AxisSystem.1;3);None:();Cf11:());Face:(Brp:(AxisSystem.1;2);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPe rmanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", axisSystem1)
Set hybridShapeDirection4 = hybridShapeFactory1.AddNewDirection(reference7)
Set reference8 = part1.CreateReferenceFromObject(hybridShape)
Set hybridShapeExtremum4 = hybridShapeFactory1.AddNewExtremum(reference8, hybridShapeDirection4, 0)
hybridShapeExtremum4.Name="MinZ"
Set reference12 = part1.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(AxisSystem.1;1);None:();Cf11:());Face:(Brp:(AxisSystem.1;3);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPe rmanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", axisSystem1)
Set hybridShapeDirection8 = hybridShapeFactory1.AddNewDirection(reference12)
hybridShapeExtremum4.Direction2 = hybridShapeDirection8
hybridShapeExtremum4.ExtremumType2 = 0
hybridBody1.AppendHybridShape hybridShapeExtremum4
part1.InWorkObject = hybridShapeExtremum4
part1.Update
part1.Update
sSel.Clear
sSel1.Clear
End Sub