HybridShapes ohne gültige Lösung erkennen (Dassault Systemes - PLM Solutions/CATIA V5 Programmierung)

Guten Tag allerseits,

in einer Excel-Datei liegen die 2D-Koordinaten einer Punktewolke vor (x- und z-Koordinaten), diese möchte ich auf einer 3D-Fläche abbilden. Zu diesem Zweck importiere ich in CATIA über mein Makro die Punkte auf y = 0 und erzeuge Linien in y-Richtung. Wo sich diese Linien mit meiner 3D-Fläche schneiden liegen meine "Zielpunkte". Eine Projektion hat hier - warum auch immer - nicht geklappt: die Punkte wurden nicht exakt in y-Richtung projeziert und lagen somit irgendwo auf der Fläche...

Code:
Sub createPointsFromCSV()
On Error GoTo hell

Dim filename As String
Dim foo As String, x As String, y As String, z As String
Dim splitErgebnis As Variant
Dim joinName As String

'Geometrieelemente
Dim myPart As Part
Dim hysf As HybridShapeFactory
Dim newPoint As Point 'neu eingelesener Punkt auf Grund csv-Datei
Dim richtung As HybridShapeDirection 'Richtung für Schnittlinie
Dim neueLinie As HybridShapeLinePtDir 'Schnittlinie
Dim intersectPoint As HybridShapeIntersection

'Geosets
Dim linienBody As HybridBody
Dim punkteBody As HybridBody
Dim intersectBody As HybridBody
Dim joinBody As HybridBody

Dim rotWert As Long, gelbWert As Long
Dim punktWert As Double
'Selection wird zur Änderung der Farbeigenschaften benötigt
Dim sel As Selection


   '#####Beginn#####
'Dateinamen der csv-Datei erfragen, wenn "Abbruch", dann sub verlassen
filename = CATIA.FileSelectionBox(".csv-Datei auswählen", "*.csv", CatFileSelectionModeOpen)
If filename = "" Then Exit Sub

Set myPart = CATIA.ActiveDocument.Part
Set hysf = myPart.HybridShapeFactory
Set sel = CATIA.ActiveDocument.Selection
Set richtung = hysf.AddNewDirectionByCoord(0, -1, 0)

Set linienBody = myPart.HybridBodies.Add
Set punkteBody = myPart.HybridBodies.Add
Set intersectBody = myPart.HybridBodies.Add
Set legendeBody = myPart.HybridBodies.Add

joinName = InputBox("Wie lautet das Geoset, das die Flächendaten zur Schnitterzeugung beinhaltet?")
Set joinBody = myPart.HybridBodies.Item(joinName)

linienBody.Name = "Linien"
punkteBody.Name = "Punkte"
intersectBody.Name = "Intersections"
legendeBody.Name = "Legende"

For Each strak In joinBody.HybridShapes
Open filename For Input As #1
Do While Not EOF(1)
Line Input #1, foo
'eingelesene Zeile zerlegen; Syntax: "X;Y;Z;PUNKTWERT"
splitErgebnis = Split(foo, ";")
x = CDbl(Val(splitErgebnis(0)))
y = CDbl(Val(splitErgebnis(1)))
z = CDbl(Val(splitErgebnis(2)))
punktName = splitErgebnis(3)

'##########Punkte erzeugen im Geo-Set "Punkte"##########################################
Set newPoint = hysf.AddNewPointCoord(x, y, z)
punkteBody.AppendHybridShape newPoint
'########################################################################################

'##########Linien erzeugen im Geo-Set "Linien"##########################################
Set neueLine = hysf.AddNewLinePtDir(newPoint, richtung, 0, 2000, False)
linienBody.AppendHybridShape neueLine
'########################################################################################

'##########neue Punkte auf Basis Intersect erzeugen im Geo-Set "Intersections"###########
Set intersectPoint = hysf.AddNewIntersection(neueLine, strak)
intersectBody.AppendHybridShape intersectPoint

'jedes Element einzeln berechnen, sonst gibt es beim ersten Ungültigen einen
'Update-Error
intersectBody.HybridShapes.Item(intersectBody.HybridShapes.Count).Compute
intersectPoint.Name = punktName

'Farbe ändern
sel.Add intersectPoint
punktWert = CDbl(Val(punktName))
If Abs(punktWert) > 5 Then
rotWert = 255
gelbWert = 0
Else

gelbWert = 255 - Abs(punktWert) * 255 / STUFIGKEIT_FARBUNTERSCHEIDUNG
End If
sel.VisProperties.SetRealColor 255, gelbWert, 0, 1
sel.Clear
'########################################################################################
Loop
Close #1
Next
'Selection leeren
sel.Clear

'nicht benötige Geosets in's no-show schicken
sel.Add linienBody
sel.Add punkteBody
sel.VisProperties.SetShow catVisPropertyNoShowAttr

'Selection leeren, danach Legende erzeugen
sel.Clear
For i = 1 To STUFIGKEIT_FARBUNTERSCHEIDUNG
Set legendeFeld = hysf.AddNewExtrude( _
hysf.AddNewLinePtDir(hysf.AddNewPointCoord(0, 0, -100 - (i - 1) * 100), hysf.AddNewDirectionByCoord(0, 0, -1), 0, 80, False) _
, 80, 0, hysf.AddNewDirectionByCoord(0, 1, 0))
legendeBody.AppendHybridShape legendeFeld
legendeBody.HybridShapes.Item(legendeBody.HybridShapes.Count).Compute

gelbWert = 255 - 255 / i
sel.Add legendeFeld
sel.VisProperties.SetRealColor 255, gelbWert, 0, 1
sel.Clear
Next i
myPart.Update

Exit Sub

hell:
MsgBox "Fehler!" & vbCrLf & Err.Description, vbCritical
End Sub

Soweit so gut, das Makro tut auch was es soll, allerdings ist die zu Grunde liegende Excel-Datei teilweise etwas unsauber. Es kann vorkommen, dass es für die Intersection-Operation keine Lösung gibt, da die Linie die Fläche nicht schneidet.

Ich finde nun keine Möglichkeit, auf diese nicht-lösbaren HybridShapes (Darstellung siehe Anhang) zu prüfen, um sie wieder aus dem Baum raus zu werfen Ein Durchgehen von Hand ist nicht möglich, da es sich um mehrere Tausend Punkte handeln kann...

Kennt hier jemand eine Möglichkeit? Wenn jemand eine grundsätzlich bessere Idee hat, wie man das Problem lösen kann bin ich natürlich dankbar

Gruß,
Peter

[Diese Nachricht wurde von pdrechsel am 29. Okt. 2012 editiert.]

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