Code:
Sub CATMain()'---------------------------------------- Tuerfaeche drehen -------------------------------------------------
Dim myDoc As Document
Set myDoc = CATIA.ActiveDocument
'--------- 3D Werkzeugkasten definieren ----------------------
Dim Hauptkoerper As Part
Set Hauptkoerper = CATIA.ActiveDocument.Part
Dim Wzk3D As HybridShapeFactory
Set Wzk3D = Hauptkoerper.HybridShapeFactory
'---------------------------------------------------------------------
'--------- Referenzen deklarieren ------------------------------
' Auswahl festlegen -------------------
Dim Was(0)
Was(0) = "Face"
'-------------------------------------------
' Selektion definieren und leeren ----
Dim UserSel As Object
Set UserSel = myDoc.Selection
UserSel.Clear
'------------------------------------------
' Selektion vornehmen lassen -------
Dim Auswahl
Box = MsgBox("Bitte wählen Sie die Fläche der Tür aus", vbInformation + vbOKCancel, "Fläche der Tür auswählen")
If Box = vbCancel Then
Box = MsgBox("Sie haben die Selektion abgebrochen" + Chr(10) + "Das Makro wird nun beendet!", vbCritical, "Abbruch durch Nutzer")
Exit Sub
End If
Auswahl = UserSel.SelectElement2(Was, "Fläche der Tür auswählen", False)
If Auswahl = "Normal" Then
Set Tuerflaeche = UserSel.Item(1).Value
Else
Box = MsgBox("Sie haben die Selektion abgebrochen" + Chr(19) + "Das Makro wird beendet!", vbCritical, "Abbruch durch Nutzer")
Exit Sub
End If
UserSel.Clear
'-----------------------------------------
'---------------------------------------------------------------------
'--------- Rotation vordefinieren -------------------------------
Dim Rot As HybridShapeRotate ' Objekt Rot deklarieren
Set Rot = Wzk3D.AddNewEmptyRotate() ' Zuweisung
Rot.ElemToRotate = Tuerflaeche 'FUNKTIONIERT NICHT!!!!!!!
Rot.VolumeResult = False
Rot.RotationType = 0
Dim reference2 As Reference
Set reference2 = Hauptkoerper.Parameters.Item("Result of Copy of Scharnierachse")
Rot.Axis = reference2
Rot.AngleValue = -78#
'--------------------------------------------------------------------
'------- Rotation zuweisen -----------------------------------------
Dim Geo As HybridBodies
Set Geo = myDoc.Part.HybridBodies
Dim Flaechen As HybridBody
Set Flaechen = Geo.Item("Gedrehte Tuerflaeche") 'Set ist schon vorhanden
Flaechen.AppendHybridShape Rot
'--------------------------------------------------------------------
Hauptkoerper.Update
'------------------------------------------------------------------------------------------------------------------
End Sub