---

hallo Forum,
ich möchte mehreren Solid - Faces von gleicher Farbe eine Neue Farbe zuweisen.
lässt sich das durch ein Makro bewerkstelligen?

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

---

Hallo,
kurze Frage, kurze Antwort:
Ja, das geht.

Gruss
TomTom

------------------
tomtom1972

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

---

Hallo tomtom1972,

danke für die kurze Antwort.
Wie sähe denn da ein Lösungsansatz aus?

Gruß
meinlieberscholli

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

---

Hallo,

der Ansatz sieht so aus

- ein Selection.Search("Topology.CGMFace,sel") über das selektierte Volumen gibt alle Breps (Teilflächen) des Volumens zurück
- jedes Selection.Item(n) in ein Array übergeben
- Selection.Clear
- jedes Feld des Arrays in einer Loop einzeln in die Selection zufügen und über das VisPropertieSet der Selection die Farbe der Teilfläche ändern (Selection.VisProperties.SetRealColor 0,0,0,0)

Fertig.
Gruss TomTom

------------------
tomtom1972

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

---

vielen Dank für Deine Hilfe.
Dann werd ich mal versuchen mich da durchzukämpfen!

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

---

Hallo meinlieberscholli,

wenn du detaillierte Fragen hast und irgendwo nicht weiterkommst, frag nach. Dein Vorhaben ist nicht ganz trivial. Weisst du, wie du Arrays mit dem Inhalt einer Selektion "füllst" und umgekehrt?

Gruss
TomTom

------------------
tomtom1972

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

---

Hallo TomTom,

ehrlich gesagt habe ich noch nicht allzu viel Ahnung von der Materie.
Zu Deiner Frage: nein weiss ich nicht.
Ich hatte mir das Ganze etwas einfacher vorgestellt.

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

---

Hallo,

öffne ein Part und selektiere das Volumen / Solid / die Surface, deren Teilflächen umgefärbt werden sollen.
Viel Spass damit.

Gruss TomTom

Language="VBSCRIPT"

Sub CATMain()

Set oDoc = Catia.ActiveDocument
Set oProd = oDoc.Product
Set oSelection = oDoc.Selection
Set oVisPropertySet = oSelection.VisProperties
If oSelection.Count <> 1 Then
  MsgBox "Bitte zuerst eine Selektion vornehmen. Abbruch.", 48, "Error"
  Exit Sub
End If
sRGB_Old = InputBox("RGB-Wert der Flächen, die umgefärbt werden sollen", "Eingabe", "0,0,0")
If sRGB_Old = "" Then
  Exit Sub
Else
  aRGB_Old = FUNC_RGB(sRGB_Old)
  If IsEmpty(aRGB_Old) Then
      Exit Sub
  End If
End If
sRGB_New = InputBox("RGB-Wert der Flächen, die umgefärbt werden sollen", "Eingabe", "0,0,0")
If sRGB_New = "" Then
  Exit Sub
Else
  aRGB_New = FUNC_RGB(sRGB_New)
  If IsEmpty(aRGB_New) Then
      Exit Sub
  End If
End If
oSelection.Search ("Topology.CGMFace,sel")
Dim aSurf()
ReDim aSurf(oSelection.Count)
For i = 1 To oSelection.Count
  Set aSurf(i) = oSelection.Item(i)
Next
oSelection.Clear
Dim R As Long, _
    G As Long, _
    B As Long, _
    iCount As Integer
    iCount = 0
For i = 1 To UBound(aSurf)
  oSelection.Clear
  oSelection.Add (aSurf(i).Reference)
  oVisPropertySet.GetRealColor R, G, B
  If R = CLng(aRGB_Old(0)) And G = CLng(aRGB_Old(1)) And B = CLng(aRGB_Old(2)) Then
      oVisPropertySet.SetRealColor CLng(aRGB_New(0)), CLng(aRGB_New(1)), CLng(aRGB_New(0)), 0
      iCount = iCount + 1
  End If
Next

MsgBox iCount & " Flächen wurden umgefärbt.", 64, "Info"

End Sub

Function FUNC_RGB(sRGB)
  Dim bErr as Boolean
  bErr = true
  aRGB = Split(sRGB, ",")
  If UBound(aRGB) = 2 And bErr Then
      For i = 0 To UBound(aRGB)
        If Not (aRGB(i)) = "" And bErr Then
            If Not IsNumeric(aRGB(i)) Or Int(aRGB(i)) < 0 Or Int(aRGB(i)) > 255 Or Not bErr Then
              bErr = false
            End If
        Else
            bErr = false
        End If
      Next
  Else
      bErr = false
  End If
  If Not bErr Then
      MsgBox "Falsche Eingabe. Abbruch.", 48, "Error"
      Exit Function
  Else 
      FUNC_RGB = aRGB
  End if
End Function

------------------
tomtom1972

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

---

Fehler.jpg

Hallo TomTom,

is ja Wahnsinn.
Wie hast Du das so schnell hingekriegt?
Hab's mal gestartet und bringt folgende Fehlermeldung (Anhang)

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

---

Hallo,

das war die Beschäftigung in meiner Frühstückspause.
Du musst das ganze in ein CATScript einfügen, dann gehts.
Oder die Zeilen
Dim R As Long, _
    G As Long, _
    B As Long, _
    iCount As Integer
ändern in
Dim R, G, B ,iCount

und
Dim bErr as Boolean
ändern in
Dim bErr

sonst läuft das nicht im catvbs.

Jetzt sollte es gehen.

Gruss TomTom

------------------
tomtom1972

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

---

Hallo TomTom,

das Makro hat jetzt 1,5 Stunden gerödelt und dann die Meldung gebracht 612 Flächen umgefärbt zu haben.
Leider konnte ich mir das Ergebnis nicht mehr anschauen, da sich Catia entschlossen hat, sich zu verabschieden.

Der Vorgang scheint doch etwas komplex zu sein.

Trotzdem vielen Dank für Deine Unterstützung.

Frohes Fest und einen guten Rutsch

Gruss

meinlieberscholli

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