Ich hab mal wieder ein wenig weiter gemacht.
Mittlerweile klappt das auch zumindest ein gewisses Stück weit. Allerdings bleibt es dann an der Support für den Extract hängen. Hier wird ja wieder eine Referenz verlangt. Im Locals Window sehe ich auch, das ein Wert eingelesen wurde (bzw. eine Referenz), aber ich verstehe nicht warum es dann nicht mehr weiter geht.
Also die Zeile in der es hängen bleibt ist folgende:
Code:
hybridShapeExtract1.Support = UserSel2.Item2(1).Reference
EDIT:
Also ich habs auch nochmal mit dem selben Code versucht nur die entsprechende Zeile geändert:
Code:
hybridShapeExtract1.Support = reference2
Bringt allerdings auch nicht.
Folgende Fehlermeldung taucht auf:
Zitat:
Run Time error '2147467259 (80004005)
Method 'SurChargeQI' of object 'HybridShapeExtract' failed.
Ich habe es schon gegooglet usw, jedoch komme ich zu keiner gescheiten Lösung....
Und mein bisheriger gesamter Code sieht so aus:
'#############
'CLOSE SURFACE
'#############
Sub CATMain()
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim MyCatiaDocument As Document
Set MyCatiaDocument = CATIA.ActiveDocument
Dim MsgBoxReturn1 As VbMsgBoxResult
Set UserSel1 = MyCatiaDocument.Selection
'Anschließend andere variable um nicht nur für dieses Part anwendbar
'Andere Variable für die Edge wählen
'UserSelection für die Kante um Boundary zu erstellen
'danach UserSelection für den Support
'danach wird diese Auswahl übernommen um darüber einen Fill zu erstellen
'##################
'USERSELECTION EDGE
'##################
MsgBoxReturn = MsgBox("Wählen Sie die Kante des zu schließenden Loches aus!", vbOKCancel, "Auswahl Edge")
If MsgBoxReturn = vbCancel Then
MsgBox "Auswahl wurde abgebrochen."
Exit Sub
Else
Dim InputObjectType1(0)
InputObjectType1(0) = "Edge"
UserSel1.Clear
Dim Status1
Status1 = UserSel1.SelectElement2(InputObjectType1, "Wählen Sie die Kante des zu schließenden Loches aus, um einen Extract zu erstellen. ", False)
End If
'######################################
'EDGE [EXTRACT]
'######################################
'variable der Userselction für Edge
'CreatReferenceFromObject -> Edge
Dim reference1 As Reference
Set reference1 = UserSel1.Item2(1).Reference
Dim hybridShapeExtract1 As hybridShapeExtract
Set hybridShapeExtract1 = hybridShapeFactory1.AddNewExtract(reference1)
hybridShapeExtract1.PropagationType = 1
hybridShapeExtract1.ComplementaryExtract = False
hybridShapeExtract1.IsFederated = False
'##################
'USERSELECTION FACE
'##################
Dim MyCatiaDocument2 As Document
Set MyCatiaDocument2 = CATIA.ActiveDocument
Dim MsgBoxReturn2 As VbMsgBoxResult
Set UserSel2 = MyCatiaDocument2.Selection
MsgBoxReturn = MsgBox("Wählen Sie die Fläche aus, die als Support des Extracts dient!", vbOKCancel, "Auswahl Face")
If MsgBoxReturn = vbCancel Then
MsgBox "Auswahl wurde abgebrochen."
Exit Sub
Else
Dim InputObjectType2(0)
InputObjectType2(0) = "Face"
UserSel2.Clear
Dim Status2
Status2 = UserSel2.SelectElement2(InputObjectType2, "Wählen Sie die Fläche die als Support des Loches dient aus, um einen Extract zu erstellen. ", False)
End If
'######################################
'FACE [EXTRACT]
'######################################
'variable der Userselction für support fläche
'CreateReferenceFromGeometry -> Fläche
Dim reference2 As Reference
Set reference2 = UserSel2.Item2(1).Reference
'############################
'Die Referenz muss noch anders eingebunden werden!
'
'hybridShapeExtract1.Support = reference2
hybridShapeExtract1.Support = UserSel2.Item2(1).Reference
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Geometrical Set") 'Speicherort des Extracts
hybridBody1.AppendHybridShape hybridShapeExtract1
part1.InWorkObject = hybridShapeExtract1
part1.Update
'######################################
'FILL
'######################################
'Referenz/Variable von Boundary aufnehmen
Dim hybridShapeFill1 As HybridShapeFill
Set hybridShapeFill1 = hybridShapeFactory1.AddNewFill()
Dim reference3 As Reference
Set reference3 = part1.CreateReferenceFromObject(hybridShapeExtract1)
hybridShapeFill1.AddBound reference3
hybridShapeFill1.Continuity = 0
hybridBody1.AppendHybridShape hybridShapeFill1
part1.InWorkObject = hybridShapeFill1
part1.Update
'######################################
'MSGBOX
'######################################
'erneut Loch schließen? Schleife erstellen um ein weiteres Loch zu schließen.
End Sub
[/CODE]
Vielen Dank für jegliche Hilfe
[Diese Nachricht wurde von 4ppU am 22. Jun. 2016 editiert.]
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP