---

Hallo Leute,

ich hab folgendes Problem: Ich brauche in meinem Part einen Bezugspunkt, der in meinem geometrischen Set auftauchen soll. Nun habe ich versucht das folgendermassen zu lösen:

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 Referenzkoord As HybridShapePointCoord
Set Referenzkoord = hybridShapeFactory1.AddNewPointCoord(0#, 40#, 0#)

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Referenzpunkte")

hybridBody1.AppendHybridShape Referenzkoord

part1.InWorkObject = Referenzkoord

part1.Update

End Sub

Allerdings erzeugt er mir jedes mal einen neuen Punkt. kann ich über eine If Schleife abfragen, ob der Punkt schon vorhanden ist?
Oder kann ich es auch so lösen, dass er einen Punkt erzeugt, den umbenennt und damit den alten Punkt eresetzt?

Danke schon mal im Vorraus
mfg, donbastiano

------------------
bau den sofa grade

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus
Ja, man kann mit einer Schleife abfragen ob der Punkt/GeoSet schon vorhanden ist. Dazu diese umbenennen (damit einfacher darauf zugegriffen werden kann), diese über den Namen einem Objekt zuweisen. Falls der Punkt/GeoSet nicht vorhanden ist, kann man den Fehler abfangen und den Punkt/GeoSet erzeugen. zB:

Code:

---

Sub CATMain()

Dim partDocument1 As PartDocument
Dim part1 As Part
Dim hybridShapeFactory1 As HybridShapeFactory
Dim hybridBodies1 As HybridBodies
Dim Referenzkoord As HybridShapePointCoord

'Dokument geöffnet?
If CATIA.Documents.Count = 0 Then
    Exit Sub
End If

'Part geöffnet?
Set partDocument1 = CATIA.ActiveDocument
If TypeName(partDocument1) <> "PartDocument" Then
    Exit Sub
End If

'GeoSet vorhanden?
Set part1 = partDocument1.Part
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridBodies1 = part1.HybridBodies
On Error Resume Next

Set hybridBody1 = hybridBodies1.Item("Referenzpunkte")
If Err.Number <> 0 Then
    Set hybridBody1 = hybridBodies1.Add
    hybridBody1.Name = "Referenzpunkte"
    Err.Clear
End If

'Punkt vorhanden
Set Referenzkoord = hybridBody1.HybridShapes.Item("Referenzpunkt")
If Err.Number <> 0 Then
    Set Referenzkoord = hybridShapeFactory1.AddNewPointCoord(0#, 40#, 0#)
    Referenzkoord.Name = "Referenzpunkt"
    hybridBody1.AppendHybridShape Referenzkoord
   
    Err.Clear
End If

part1.InWorkObject = Referenzkoord
part1.Update

On Error GoTo 0

End Sub

---

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP