---

Hallo Experten,

ich beschäftige mich seit einiger Zeit mit VBA macros in Catia und habe bereits einige Probleme damit gelöst bekommen, aber jetzt hänge ich fest. Ziel des Programms ist viele (sehr viele (Millionen!)) Punkte auf einer Fläche (Freiform) zu erstellen. Die Punkte sollen entlang einer eingegebenen Richtung erstellt werden und einen Dynamischen Abstand haben. Dieser Abstand hängt von der Entfernung zu einer anderen Freiformfläche ab. Das derzeitige Makro erzeugt das Ergebnis wie gewollt, aber zu langsam (bzw. die Geschwindigkeit nimmt immer weiter ab) außerdem läuft der Arbeitsspeicher zur Laufzeit voll. Am Ende sollen die Koordinaten der Punkte in eine Datei (ASCII) geschrieben werden. Die Punkte selbst interessieren mich nach dem schreiben in diese Datei nicht mehr.

Mein Programm funktioniert derzeit folgendermaßen:
Durch ein UserForm werden folgende Inputs gegeben: Zielfläche, Abstandsfläche, Ursprungspunkt, 2 Richtungen, Richtung zur Abstandsfläche

-Vom Ursprungspunkt wird eine Projektion auf die Abstandsfläche erstellt
-Entfernung zwischen Ursprungspunkt und Projektion wird berechnet
-Entlang der Richtung wird ein Punkt auf der Zielfläche erzeugt mit dem errechnetem Abstand
-Die Koordinaten des neuen Punktes werden in eine Datei geschrieben
-Der Punkt und die Projektion wird gelöscht
-usw...

hier der code des Hauptprogramms:

Code:

---

Sub PointErrorCode(Part, TargetSurface, PitchSurface, Origin, MajorDirection, MinorDirection, ProjectionDirection)
    CATIA.RefreshDisplay = False

    Set TextStream = CreateMappingFile()
    Set GeometricalSet = CreateHybridBody(Part)
   
    Dim AutoSelection As Object
    Set AutoSelection = CATIA.ActiveDocument.Selection
    AutoSelection.Clear
    AutoSelection.Add GeometricalSet
    AutoSelection.VisProperties.SetShow catVisPropertyNoShowAttr
   
   
    Set HybridShapeFactory = CreateHybridShapeFactory(Part)
    Set Boundary = CreateBoundary(Part, GeometricalSet, HybridShapeFactory, TargetSurface)
    Dim OriginCoordinates(2)
   
    'Constants for Pitch Mapping
    Dim XVector(2), YVector(2), ActualScale(2)
    'Constant XVector
    XVector(0) = 1
    XVector(1) = 0
    XVector(2) = 0
   
    'Constant YVector
    YVector(0) = 0
    YVector(1) = 1
    YVector(2) = 0
   
    'Constant ActualScale
    ActualScale(0) = 1
    ActualScale(1) = 1
    ActualScale(2) = 1
   
    Set ActualDirection = MajorDirection
    Set ActualInputPoint = Origin
    ErrorPoint = False
    OppositeSide = False
    PositiveLength = True
    RunThisLoop = True
    ActualLength = 0
    NumberOfErrorPoints = -1
    NumberOfExceptionalCase1Runs = 0
    NumberOfDefaultPoints = 0
    NumberOfTextures = 0
   
    Set FirstPointOnSurface = CreatePointOnSurface(TargetSurface, ActualInputPoint, ActualDirection.Dir, HybridShapeFactory, GeometricalSet, Part, ActualLength)
    Set FirstPointInDirection = FirstPointOnSurface
    Set ActualInputPoint = FirstPointOnSurface
    FirstPointOnSurface.GetCoordinates OriginCoordinates
   
    Call WriteInMappingFile(TextStream, GetPosition(ActualInputPoint, FirstPointOnSurface), XVector, YVector, ActualScale)
    NumberOfTextures = NumberOfTextures + 1
   
    Set ProjectedPoint = ProjectPointDirection(ActualInputPoint, ProjectionDirection.Dir, PitchSurface, GeometricalSet, Part, HybridShapeFactory)

    FirstLengthMeasuredOnSurface = MeasureDistanceBetweenPointAndBoundary(FirstPointOnSurface, ProjectedPoint)

'    Set LineBetweenPoints = CreateLine(ActualInputPoint, ProjectedPoint, HybridShapeFactory, GeometricalSet, Part)
'    FirstLengthMeasuredOnSurface = MeasureLineLength(LineBetweenPoints)
    FirstLengthInDirection = FirstLengthMeasuredOnSurface
    ActualLength = FirstLengthMeasuredOnSurface
    Call DeleteAnyObject(ProjectedPoint)
    'Call DeleteAnyObject(LineBetweenPoints)
   
    Do Until RunThisLoop = False
        If ErrorPoint = False Then
            Set LastInputPoint = ActualInputPoint
            Set LastProjectedPoint = ProjectedPoint
            'Set LastLineBetweenPoints = LineBetweenPoints
            Set ActualInputPoint = CreatePointOnSurface(TargetSurface, FirstPointInDirection, ActualDirection.Dir, HybridShapeFactory, GeometricalSet, Part, ActualLength)
            If MeasureDistanceBetweenPointAndBoundary(ActualInputPoint, Boundary) = 0 Then
                Call DeleteAnyObject(ActualInputPoint)
                NumberOfErrorPoints = NumberOfErrorPoints + 1
                ErrorPoint = True
                NumberOfDefaultPoints = 0
            Else
                Set ProjectedPoint = ProjectPointDirection(ActualInputPoint, ProjectionDirection.Dir, PitchSurface, GeometricalSet, Part, HybridShapeFactory)
                'Set LineBetweenPoints = CreateLine(ActualInputPoint, ProjectedPoint, HybridShapeFactory, GeometricalSet, Part)
                If PositiveLength = True Then
                    ActualLength = ActualLength + MeasureDistanceBetweenPointAndBoundary(ActualInputPoint, ProjectedPoint)
                Else
                    ActualLength = ActualLength - MeasureDistanceBetweenPointAndBoundary(ActualInputPoint, ProjectedPoint)
                End If
                Call WriteInMappingFile(TextStream, GetPosition(ActualInputPoint, FirstPointOnSurface), XVector, YVector, ActualScale)
                NumberOfTextures = NumberOfTextures + 1
                NumberOfDefaultPoints = NumberOfDefaultPoints + 1
                If NumberOfDefaultPoints >= 2 Then
                    'Call DeleteAnyObject(LastLineBetweenPoints)
                    Call DeleteAnyObject(LastProjectedPoint)
                    Call DeleteAnyObject(LastInputPoint)
                End If
            End If
        Else
            'Call DeleteAnyObject(LineBetweenPoints)
            Call DeleteAnyObject(ProjectedPoint)
            'Call DeleteAnyObject(ActualInputPoint)
            Select Case NumberOfErrorPoints Mod 2
            Case 0
                ErrorPoint = False
                Set ActualInputPoint = FirstPointInDirection
                ActualLength = -FirstLengthInDirection
                PositiveLength = False
            Case 1
                ErrorPoint = False
                Set ActualDirection = MinorDirection
                Set ActualInputPoint = FirstPointInDirection
                If OppositeSide = False Then
                    ActualLength = FirstLengthInDirection
                Else
                    ActualLength = -FirstLengthInDirection
                End If
                Set FirstPointInDirection = CreatePointOnSurface(TargetSurface, ActualInputPoint, ActualDirection.Dir, HybridShapeFactory, GeometricalSet, Part, ActualLength)
                If MeasureDistanceBetweenPointAndBoundary(FirstPointInDirection, Boundary) = 0 Then
                    Call DeleteAnyObject(FirstPointInDirection)
                    NumberOfExceptionalCase1Runs = NumberOfExceptionalCase1Runs + 1
                    If NumberOfExceptionalCase1Runs = 2 Then
                        Exit Do
                    End If
                    Set ActualInputPoint = FirstPointOnSurface
                    ActualLength = -FirstLengthMeasuredOnSurface
                    Set FirstPointInDirection = CreatePointOnSurface(TargetSurface, ActualInputPoint, ActualDirection.Dir, HybridShapeFactory, GeometricalSet, Part, ActualLength)
                    OppositeSide = True
                End If
                PositiveLength = True
                ErrorPoint = False
                Set ActualInputPoint = FirstPointInDirection
                Call WriteInMappingFile(TextStream, GetPosition(ActualInputPoint, FirstPointOnSurface), XVector, YVector, ActualScale)
                NumberOfTextures = NumberOfTextures + 1
                Set ProjectedPoint = ProjectPointDirection(FirstPointInDirection, ProjectionDirection.Dir, PitchSurface, GeometricalSet, Part, HybridShapeFactory)
                'Set LineBetweenPoints = CreateLine(FirstPointInDirection, ProjectedPoint, HybridShapeFactory, GeometricalSet, Part)
                FirstLengthInDirection = MeasureDistanceBetweenPointAndBoundary(FirstPointInDirection, ProjectedPoint)
                ActualLength = FirstLengthInDirection
                Set ActualDirection = MajorDirection
            End Select
        End If
    Loop
    CATIA.RefreshDisplay = True
    MsgBox NumberOfTextures
    UserForm3.Show
End Sub

---

Die vielen einzelnen Funktionen spare ich mir erstmal, reiche ich aber gerne nach sobald sich da Fragen ergeben.

Vielen Dank für eure Hilfe.

[Diese Nachricht wurde von dermj am 01. Apr. 2011 editiert.]

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

---

Ich habe jetzt nicht alles durchgeschaut, weiß aber, dass ich zu Studienzeiten auch mal genau so ein makro geschrieben habe, ging glaube ich um Biegebleche. :-)

Jedenfalls ein paar Tipps:
Definiere deine Variablen, ich sehe fast nur Variants, die sind Speicherschleudern, auch bei den übergaben an die Funktionen.
Arbeite mit ByRefs.
Kannst Du auch ohne die Linienerzeugung arbeiten? - Geometrie kostet Zeit
Machst Du die Updates lokal, oder auf das gesamte Part? - Lokale Updates sparen Zeit
Löschst Du die Punkte sofort wieder? - Geometrie kostet Zeit
Schreibst Du das Textfile erst am Ende, oder jedes mal? - jede Schreiboperation kostet Zeit

------------------
Mit freundlichen Grüßen,
Henry Schneider
alias Lila

Es gibt einen ewigen Wettkampf zwischen der Natur und den Ingenieuren:
Die Ingenieure versuchen, immer idioten-sicherere Systeme zu bauen,
die Natur versucht, immer bessere Idioten zu bauen

Xing

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

---

Hallo,

ergänzend zu den Bemerkunen von Henry noch ein Tipp für den Teil Geometrieerzeugung:
Wenn du den Punkt, bzw. die Hilfsgeometrien nachher nicht benötigst, kannst du diese ohne AppendHybridShape und ohne Update erzeugen. Mit Compute wird dein Objekt berechnet, erscheint aber nicht im Baum.
Andere Möglichkeit wäre dein Punkt parametrisch aufzubauen und nur die Werte der Parameter ändern und nachher den LocalUpdate ausführen.

Gruß,
Zoltan

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

---

Vielen Dank für eure Vorschläge. Einige davon werde ich heute abend gleich mal einpflegen (Nachdem ich herausgefunden habe wie es geht)

Das mit dem Compute klingt sehr gut. Kann ich denn auch an so einem Objekt ein "Measure" durchführen?Auch der Parametrische Ansatz hat viel schönes, glaube ich.

Also zur Zeit schreibe ich die Punkte gleich nach dem erstellen in das Textfile. Wäre es denn deulich schneller diese zur Laufzeit in ein Array abzulegen und dieses dann nochmal in einem getrennten Prozess in die Datei zu schreiben?

Außerdem hätte ich da das Problem, dass ich vorher nicht weiß, wie groß das Array dimensioniert sein muss.
Die Linien habe ich bereits wegrationalisiert. 

Ich melde mich morgen nochmal mit dem Fortschritt.
Aktuell: 16004 Punkte ca. 1h30min

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

---

Zitat:

---

Original erstellt von dermj:

Also zur Zeit schreibe ich die Punkte gleich nach dem erstellen in das Textfile. Wäre es denn deulich schneller diese zur Laufzeit in ein Array abzulegen und dieses dann nochmal in einem getrennten Prozess in die Datei zu schreiben?

Außerdem hätte ich da das Problem, dass ich vorher nicht weiß, wie groß das Array dimensioniert sein muss.
Die Linien habe ich bereits wegrationalisiert.  

---

Ja das wäre in jedem Fall deutlich schneller, da du jedes mal das File öffnen, etwas schreiben und wieder schließen musst. Dabei werden etlich Prozesse vom Betriebssystem genutzt, die zwar bei Einzelzugriffen nicht spürbar sind, aber bei derart vielen Schritten in Summer schon einiges ausmachen können.

Wenn du nicht weist, wie groß dein Array sein muss, dann kannst du mit redim preserve arbeiten. Dabei werden die vorhanden Inhalte nicht gelöscht und die Größe des Array neu definiert.

Code:

---

Dim Zählen() as Integer
Dim i as Integer

redim Zählen(0)

For i = 0 To 45
  If I > Ubound(Zählen) then
      redim preserve Zählen(i)
  endif
  Zählen(i) = i
next

---

Allerdings möchte ich behaupten, dass auch das Performanceeinbusen mit sich bringt...

------------------
MFG
Rick Schulz

Nettiquette (CAD.de)  -  Was ist die Systeminfo?  -  Wie man Fragen richtig stellt.  -  Unities

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

---

Servus
Kleiner Hinweis zu Ricks Ausführungen.
"Predim preserve" geht AFAIK nur bei eindimensionalen Arrays.

Gruß
Bernd

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

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

---

 

Zitat:

---

Original erstellt von bgrittmann:

"Predim preserve" geht AFAIK nur bei eindimensionalen Arrays.

---

Hallo Bernd,
das geht auch bei 2 dimensionalen Arrays, allerdings darf nur 1 Dimension erhöht werden. Das hab ich selbst schon gemacht. Ist zwar etwas tricky, aber in der Regel hat man eh eine Dimension fest sprich z.B. 3 Parameter und weis nur nicht für wieviele Objekte diese geschrieben werden müssen.

------------------
MFG
Rick Schulz

Nettiquette (CAD.de)  -  Was ist die Systeminfo?  -  Wie man Fragen richtig stellt.  -  Unities

   

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

---

Zitat:

---

Die vielen einzelnen Funktionen spare ich mir erstmal, reiche ich aber gerne nach sobald sich da Fragen ergeben.

---

Statt Arrays - möglicherweise gar mit redim - bieten sich Dictionaries (bzw. Collections) an. Ist viel performanter. Statt ständig in eine Textdatei zu schreiben kommt alles in ein Dictionary und wird dann in einem Rutsch geschrieben.

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

---

Danke für eure tollen und zahlreichen Vorschläge, die Umsetzung bis morgen ist da wohl Utopie, es gibt viel zu tun...

Und schon fangen die Probleme an, ich habe versucht die Sache mit dem "compute" einzubinden. Dabei stelle ich fest, das Makro stürzt beim aufrufen des Löschbefehls, "DeleteAnyObject"-Funktion, ab. Klar, diese Funktion benutzt eine Selection. Es ist ja nichts mehr da zum Selektieren. Also schnell alles auskommentiert und siehe da, das Makro funktioniert wieder aber noch langsamer als vorher. :-(
Drängt sich der Verdacht auf, das alle Punkte jetzt irgendwie doch da sind, nur nicht im Baum.
Wie kann ich diese denn, mit "compute" erzeugten Objekte denn jetzt löschen?

Das Dictionary klingt nach einer sehr guten Lösung für das Dateischreibproblem.
Danke nochmals für eure Unterstützung.

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

---

Ich schätze, die Punkte kann man nicht löschen. (Eine Verwendung für diese Methode ist, wenn du die Objekte unter anderen erzeugen möchtest, z.B. die Endpunkte einer Linie unter die Linie, siehe auch im Buch von Jens Hansen.) Diese Menge an Daten habe ich noch nie damit erstellt.
Dann solltest du den parametrischen Ansatz versuchen.

War bei deiner ursprünglichen Version die Zeitbedarf mit der Punktanzahl linear angestiegen oder war da die Ende auch bedeutend langsamer?
Vielleicht liegt ein Teil der Performanceprobleme generell beim Speicherbedarf.

Versuche zwischenmal nach je 1000 Punkte oder so zu speichern, vielleicht wird dadurch ein Teil der Speicher befreit.

Bei Punkte ins Datei schreiben kannst du auch mit einen fixen Arraygröße arbeiten (Redim Preserve funktioniert zwar, ist aber ab einen Zeitpunkt auch langsam) und anstelle von Redim Preserve das Ausschreiben in die Datei erledigen. (z.B. nach je 500 Punkte und am Ende)

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

---

Hallo,

ich wollte mal ein kurzes Update schicken, ich bin noch nicht ganz fertig, aber die Zwischenergebnisse sehen wie folgt aus.

Das selbe Szenario:
16080 Punkte werden in 13 Minuten abgefahren (aber noch nicht ausgelesen)
Der Speicherbedarf ist von ca.4GB am Ende auf knappe 400MB geschrumpft.

Die Angewendeten Methoden sind:
definierte Variablendeklaration
definierte Variablenübergabe
2 parameterisierte Punkte (jeweils für die beiden Hauptrichtungen)

Ich musste dafür mehr oder weniger das gesamte Programm ändern, deshalb das verspätete Feedback.Nun versuche ich mal das Dictionary aufzusetzen und zu füllen. :-)

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

---

Also wenn Du es sowieso in eine Textdatei schreibst, dann kannst Du die Werte doch einfach in einem String statt in einem Dictonary oder Collection halten.

Also immer die neuen Sachen an den String anhängen und zum Schluss einfach den String die Datei schreiben.
Wenn Du ein Objekt nicht in den Baum hängst, also nur mti Compute arbeitest, brauchst Du es glaube ich nicht löschen, da dies dann der Garbedgecollector macht, soweit ich mich entsinnen kann. Das ist aber nur eine Vermutung, das muss getestet werden.

Und so ein redim kostet ansonsten auch viel Zeit, wenn man es oft macht, da wär es schön, wenn man am Anfang gleich die maximalgröße des Arrays ermitteln kann und dann nur ein redim macht.

Dann wären noch ein paar Sachen möglich:
Wenn deine UserForm modal ist, dann kannst Du das RefreshDisplay auf false schalten und da Du mit der Selection löschst, würde ich das HSOSynconized (oder so ähnlich) auch auf false schalten. Hinterher natürlich beides wieder auf true :-)

------------------
Mit freundlichen Grüßen,
Henry Schneider
alias Lila

Es gibt einen ewigen Wettkampf zwischen der Natur und den Ingenieuren:
Die Ingenieure versuchen, immer idioten-sicherere Systeme zu bauen,
die Natur versucht, immer bessere Idioten zu bauen

Xing

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

---

Hallo,

Also jetzt habe ich die ganze Sache für mein Referenzbauteil so optimiert, dass ich in knapp 6 min die Punkte abfahren und aufschreiben kann. Ich sammle die Daten in einer Collection und füge diese in einer Abschließenden Schleife in die Textdatei. Das Verfahren ist schnell und einfach und funktioniert bestens. Es gibt mir außerdem eine gute Möglichkeit den Funktionsumfang des Macros zu erweitern ohne da noch viel umschreiben zu müssen.

Bei der Anwendung auf einem Anderen Projekt kommt es leider zu Fehlern. Kann es sein, das der Befehl "hybridShapePointOnSurface", abhängig von der Art und Weise, wie die Fläche erstellt wurde einen Fehler ausgibt wenn die Flächengrenze erreicht wird oder eben nicht?

Also es scheint so zu sein, der Punkt wandert zur Grenze:
-in einem Fall, setzt er einfach weiter Punkte, die genau auf der Grenze liegen. Die Punkte haben aber tatsächlich immer unterschiedliche Längenparameter, die aber nicht mehr mit der gemessenen Distanz zum Ausgangspunkt übereinstimmen.
-in einem anderen Fall wird die Grenze erreicht und CATIA bricht das macro mit einer Fehlermeldung ab.

So jetzt stehe ich mal wieder auf dem Schlauch, einen der Beiden Fehler kann ich abfangen und reagieren, aber nicht beide, zumal ich ja vorher nicht weiß wann welcher Fall eintritt.

Ich habe jetzt schon eine Schleife die irgendwie unübersichtlich ist. (Viele Fallunterscheidungen) Ich habe das Gefühl, das man das ganze Problem irgendwie anders (eleganter) lösen müsste.

Hat jemand schon mal so etwas verfasst und eventuell Erfahrung mit dem Aufbau so einer Schleife?

Vielen Dank.

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

---

Die Fehlermeldung wär hier hilfreich :-)

------------------
Mit freundlichen Grüßen,
Henry Schneider
alias Lila

Es gibt einen ewigen Wettkampf zwischen der Natur und den Ingenieuren:
Die Ingenieure versuchen, immer idioten-sicherere Systeme zu bauen,
die Natur versucht, immer bessere Idioten zu bauen

Xing

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

---

Hallo,

habe mich längere Zeit nicht gemeldet, da leider auch kaum Zeit blieb an dem Projekt weiter zu arbeiten.
Aber jetzt ist's so weit... es läuft schnell, stabil (bis jetzt) und auch so wie ich es wollte.
Vielen Dank an dieser Stelle, eure Tips haben mir sehr weitergeholfen.
Jetzt muss "nur" noch die Benutzerfreundlichkeit erweitert werden.

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