Code:
'------------------------------------------------------------------------------------
' Makro: CreateJoinFromSelectedSurfaces
' Version: 0.1
' Code: CATScript
' Zweck: Erzeugen von Joins in einem gewählten GeoSet, pro gewählte Fläche wird ein Join erzeugt, der Join wird so benannt wie die Ursprungsfläche
' Autor: bgrittmann
' Datum: 08.04.2017
'------------------------------------------------------------------------------------Sub CATMain()
Dim oPartDoc As PartDocument
Dim oSelection As Selection
Dim strResult As String
Dim Filter(0)
Dim oTargetHybridbody as Hybridbody
Dim ohybridShapeFactory As Factory
dim i as Integer
dim oReference as Reference
dim oJoin as HybridShapeAssemble
'Dokument geöffnet bzw Fenster
If CATIA.Windows.Count = 0 Then
strBox = MsgBox("Es ist kein Dokument geladen!" + Chr(10) + "Das Makro kann nicht ausgeführt werden und wird beendet!", vbCritical, "Keine Dokument geladen")
Exit Sub
End If
'Dokumententyp prüfen
If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
strBox = MsgBox("Das aktive geladen Dokument ist KEIN CATPart!" + Chr(10) + "Bitte öffnen sie ein CATPart und starten sie das Makro erneut!", vbExclamation, "Abbruch falscher Dateityp")
Exit Sub
End If
'Start
Set oPartDoc = CATIA.ActiveDocument
Set ohybridShapeFactory = oPartDoc.Part.HybridShapeFactory
Set oSelection = oPartDoc.Selection
'Geo Set selektieren
Filter(0) = "HybridBody"
strResult = oSelection.SelectElement2(Filter, "Bitte wählen sie eine geometrisches Set aus in dem die Joins erstellte werden sollen.", false)
'Wurde die Selektion abgebrochen? Wenn ja, Sub verlassen
If strResult <> "Normal" Then
Exit Sub
End If
Set oTargetHybridbody = oSelection.Item2(1).Value
'Flächen selektieren
Filter(0) = "HybridShape"
strResult = oSelection.SelectElement3(Filter, "Bitte wählen sie die Flächen aus, für die jeweils ein Join erstellt werden soll.", false,CATMultiSelTriggWhenUserValidatesSelection ,true)
'Wurde die Selektion abgebrochen? Wenn ja, Sub verlassen
If strResult <> "Normal" Then
Exit Sub
End If
'Joins erstellen
for i = 1 to oSelection.Count2
Set oReference = oSelection.item2(i).Reference
Set oJoin = ohybridShapeFactory.AddNewJoin (oReference , oReference )
oJoin.RemoveElement 2
oJoin.Name = oSelection.item2(i).Value.Name
oTargetHybridbody.AppendHybridShape oJoin
oPartDoc.Part.UpdateObject oJoin
next
End Sub
Foren auf CAD.de (alle Foren)
| 
