---

Hallo

ich habe 3 Kurven im §D Raum und würde gerne prüfen ob sich die pinke Linie sich mit der Grünen bzw mit der blauen Linie verschneidet(Warnmeldung , da intersect true), wenn die es nicht tun soll es mir auch eine Meldung geben(Warnmeldung bzw vllt grünes Licht oder keine Aktion)

Ich weiß gar nicht wie ich das anstellen sollte?!?
denn die Elemnte sollen gar nicht erzeugt werden, sondern nur geprüft!

Vorüberlegung
interlect(Linie_pinkt,Linie_gruen)
intersect2(Linie_pink,Linie_blau)
If intersect=true
"Achtung ihre Lienien überscheiden sich,Programm Abbruch!"
Else
{If intersect2=true
  "Achtung ihre Lienien überscheiden sich,Programm Abbruch!"
}
else
"...weitere Aktion des Makros"

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

---

Hallo,
so ohne weiteres wird es nicht gehen, da eine Intersection, die NICHT erstellt werden kann einen Fehler verurscht. Du wirst das INtersection-Object erzeugen müssen um sicher zu gehen. Zum Schluss kannst du dann das (fehlerhafte) Intersection-Objekt über eine Selection löschen.
Vorgehensweise:
On error resume next
Create Intersection1(Linie_pinkt,Linie_gruen)
Part.Update
if err.number == 0 then
"Achtung ihre Lienien überscheiden sich,Programm Abbruch!"
end if
Selection1.Add Intersection1
Selection1.Delete
err.clear

Create Intersection2(Linie_pink,Linie_blau)
Part.Update
if err.number == 0 then
"Achtung ihre Lienien überscheiden sich,Programm Abbruch!"
end if
Selection1.Add Intersection2
Selection1.Delete
err.clear

"Create Intersection..." ist natürlich nicht die richtige Syntax aber ich denke du verstehst was ich meine  

Viel Erfolg

Jens Hansen

------------------
Inoffizielle CATIA-Hilfeseite
Private Seite
Xing

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

---

Vielen herzlichen Dank!

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

---

Ich habe ein ähnliches Problem. Ich will eine Intersection abfragen und eine MsgBox ausgegeben bekommen. Das funktioniert soweit auch.

Mein Hauptproblem: Das Löschen der Intersection klappt nicht. Es erscheint immer eine Warnung: Error Copying Data...Selected element(s) not allowed for this operation!

Woran kann das liegen?

Code:

---

Dim documents1 As Documents
Set documents1 = CATIA.Documents
Dim partDocument1 As Document
Set partDocument1 = documents1.Item("SCHABLONE_1.CATPart")
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("KONSTRUKTION")
Dim hybridBodies2 As HybridBodies
Set hybridBodies2 = hybridBody1.HybridBodies
Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies2.Item("Int")
Dim hybridBodies3 As HybridBodies
Set hybridBodies3 = hybridBody2.HybridBodies
Dim hybridBody3 As HybridBody
Set hybridBody3 = hybridBodies3.Item("Kit")
Dim hybridBodies4 As HybridBodies
Set hybridBodies4 = hybridBody3.HybridBodies
Dim hybridBody4 As HybridBody
Set hybridBody4 = hybridBodies4.Item("Kap")
Dim hybridBodies5 As HybridBodies
Set hybridBodies5 = hybridBody4.HybridBodies
Dim hybridBody5 As HybridBody
Set hybridBody5 = hybridBodies5.Item("Apm")
Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody5.HybridShapes
Dim hybridShapeCurveExplicit1 As HybridShape

Set hybridShapeCurveExplicit1 = hybridShapes1.Item("Kreis_Mitte")

Set hybridShapeCurveExplicit2 = hybridShapes1.Item("Kontur_Mitte")

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(hybridShapeCurveExplicit1)

Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(hybridShapeCurveExplicit2)

Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridShapeIntersection1 As HybridShapeIntersection
Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(reference1, reference2)

hybridShapeIntersection1.PointType = 1

hybridShapeIntersection1.ExtendMode = 0

hybridBody5.AppendHybridShape hybridShapeIntersection1

part1.InWorkObject = hybridShapeIntersection1

'Fehlerbehandlung ausschalten
On Error Resume Next

'Warnungen ausschalten
'CATIA.DisplayFileAlerts = False

part1.UpdateObject hybridBody5

MsgBox (Err.Number)

'Fehlerabarbeiten
If Err.Number = -2147467259 Then
   
        MsgBox "Keine Kreuzung vorhanden"

    Dim parameters1 As Parameters
  Set parameters1 = part1.Parameters
    Dim strParam1 As Parameter
Set strParam1 = parameters1.Item("Schablone\KONSTRUKTION\Int\Kit\Kap\Apm\Mitte")

    strParam1.Value = "OK"

    partDocument1.Selection.Clear
        partDocument1.Selection.Add hybridShapeIntersection1
      partDocument1.Selection.Delete

else
   
    MsgBox "Schnittpunkt vorhanden!"   

  strParam1.Value = "zu lang"

    partDocument1.Selection.Clear
        partDocument1.Selection.Add hybridShapeIntersection1
      partDocument1.Selection.Delete

End If

part1.UpdateObject hybridBody5

'Fehlerbehandlung einschalten
On Error GoTo 0

End sub

---

mfG

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