alle Objekte eines bestimmten Farbmodells auswählen

[asterix]

Hallo zusammen,

ich hoffe sehr, dass meine andere Anfrage zu den Knoten nicht zu sehr ausufernd war .
Aber das Folgende sollte sogar ich korrekt ausdrücken können.

Kann man in CorelDraw (vermutlich ein Makro, das weiß Koter vielleicht?) eine Funktion nutzen, mit der man:
alle Objekte (als Umrisse und Füllungen) auswählen kann, die ein bestimmtes Farbmodell haben (also CMYK oder RGB) ?

Wichtig wäre das "auswählen", weil man so diese Objekte einfach ausschneiden, kopieren oder ändern könnte.

Die Funktion mit dem Suchen & Ersetzen kenne ich auch, aber so wäre das natürlich per 1-Klick und dann auch einfach auswählen möglich. Das würde das schon erleichtern.

Viele Grüße
Asterix

[koter]

Hallo Asterix,

ich hoffe sehr, dass meine andere Anfrage zu den Knoten nicht zu sehr ausufernd war ...

Nein, und wenn schon!

Die folgenden Vierzeiler markieren Objekte mit Umriss oder Füllung
mit dem jeweiligen Farbmodell :

Code:

Sub sucheRBG()
   ActivePage.SelectableShapes.FindShapes(Query:="@fill.Color.Type = 'rgb'").CreateSelection
   ActivePage.SelectableShapes.FindShapes(Query:="@outline.Color.Type = 'rgb'").AddToSelection
End Sub

Sub sucheCMYK()
   ActivePage.SelectableShapes.FindShapes(Query:="@fill.Color.Type = 'cmyk'").CreateSelection
   ActivePage.SelectableShapes.FindShapes(Query:="@outline.Color.Type = 'cmyk'").AddToSelection
End Sub

Warnungen vor Powerclips, Gruppen usw. wie bei „Suchen & Ersetzen“ gibt es nicht.
Darauf musst Du also selbst achten.

Gruß

Koter

[asterix]

Hallo Koter,

vielen Dank, das klappt super!
Und wenn ich nur Füllung oder nur Umriss finden will, lösche ich einfach die jeweilige Zeile bzw. erstelle mir aus deinen 2 dann 4 Makros auf diese Weise.

Damit kann ich verlorengegangene RGB- oder CMYK-Objekte gut finden. Man sieht es ja auch in der Dokumenteneigenschaft oder beim Suchen, aber so ein 1-Klick-Makro mit Weiterbearbeitung der Auswahl ist einfach besser.

Ich hätte da natürlich doch noch eine Nachfrage . Von (anderen) importierten Dateien habe ich manchmal Objekte (Füllungen), die keinen Umriss haben. Soweit so gut. Im "Geheimversteck" haben sie aber doch eine Information über den Umriss, denn immer wenn ich diese Objekte dann mit einem Umriss versehe, ist dieser in CMYK. Ich lege meist RGB-Dokumente an, daher ist so etwas natürlich nicht optimal. So lange ich die Umrisse nicht vergrößere, zeigt CorelDraw keine CMYK-Objekte an. Und deine Makros finden diese natürlich auch nicht. Daher komme ich hier drauf.

Ich vermute, ein Makro kann so eine versteckte Info in einem Objekt nicht finden, richtig?
Aber irgendwo muss CorelDraw diese Info ja erkennen, dass ein Umriss "CMYK wäre", wenn man ihn erweitert.

PS: ich kann im Laufe des Tages irgendwann ein Beispiel hochladen, aber man kann es leicht selbst erzeugen, indem man eben einfach ein Rechteck anlegt mit RGB-Füllung und CMYK-Umriss und danach den Umriss wieder auf "Keine" setzt. Die CMYK-Info bleibt da irgendwo erhalten, denn wenn man den Umriss wieder erweitert, geht CorelDraw wieder auf CMYK. Mit so einem Proberechteck könnte man also ausprobieren, ob man das mit einem Makro finden kann.

[koter]

Hallo Asterix,

...Ich vermute, ein Makro kann so eine versteckte Info in einem Objekt nicht finden, richtig? ...

Ja, aber man kann in das „Geheimversteck“ kurz hineinschauen lassen
(den Objekten für die Suche einen Umriss geben):

Code:

Dim SRTemp As ShapeRange

Sub sucheRBG()
   Call UmrissZeigen
   ActivePage.SelectableShapes.FindShapes(Query:="@fill.Color.Type = 'rgb'").CreateSelection
   ActivePage.SelectableShapes.FindShapes(Query:="@outline.Color.Type = 'rgb'").AddToSelection
   Call UmrissNull
End Sub

Sub sucheCMYK()
   Call UmrissZeigen
   ActivePage.SelectableShapes.FindShapes(Query:="@fill.Color.Type = 'cmyk'").CreateSelection
   ActivePage.SelectableShapes.FindShapes(Query:="@outline.Color.Type = 'cmyk'").AddToSelection
   Call UmrissNull
End Sub

Sub UmrissZeigen(Optional x As Boolean)
   Dim gsr As ShapeRange
   ActiveDocument.Unit = cdrMillimeter
   Set SRTemp = ActivePage.SelectableShapes.FindShapes(Query:="@outline.Width = {0mm}")
   If SRTemp Is Nothing Then Exit Sub
   Set gsr = ActivePage.SelectableShapes.FindShapes(, cdrGroupShape)
   SRTemp.RemoveRange gsr
   SRTemp.Shapes.All.SetOutlineProperties 1
End Sub

Sub UmrissNull(Optional x As Boolean)
   If SRTemp Is Nothing Then Exit Sub
   SRTemp.Shapes.All.SetOutlineProperties 0
   Set SRTemp = Nothing
End Sub

Gruß

Koter

[asterix]

Auch das klappt nun sehr gut, danke!
Solche Funktionen sind ja wirklich sinnvoll und immerhin erlaubt CorelDraw dann, diese mit Makros zu ergänzen.

Ich nutze die Makros teilweise unten als Icon aufrufbar, aufgrund der Tooltips klappt da nicht immer jeder Klick und man weiß nicht, ob man das Makro ausgeführt hat oder nicht.

Als i-Tüpfelchen daher die Frage, ob man am Ende eine Meldung bringen kann, wenn nichts gefunden wurde?
Habe es selbst versucht, aber nicht geschafft (habe noch nie etwas programmiert außer früher mal bat-Dateien).

Dann wüsste man, dass das Makro ausgeführt wurde und eben nur nichts gefunden = ausgewählt wurde.

[asterix]

Und: Ich wollte als Laie wieder das Makro aufteilen, weil ich dieses Reinschauen ja nur für Umrisse brauche, und gerne einen Button für RGB und einen CMYK erstellen wurde.

(Füllung RGB und CMYK suchen und auswählen klappt perfekt, daher hier nur Umrisse)

Hier meine Versuche für einmal RGB Umriss auswählen und einmal CMYK Umriss:

Code:

Dim SRTemp As ShapeRange



Sub sucheCMYKoutline()
  Call UmrissZeigen
 
  ActivePage.SelectableShapes.FindShapes(Query:="@outline.Color.Type = 'cmyk'").CreateSelection
  Call UmrissNull
End Sub

Sub UmrissZeigen(Optional x As Boolean)
  Dim gsr As ShapeRange
  ActiveDocument.Unit = cdrMillimeter
  Set SRTemp = ActivePage.SelectableShapes.FindShapes(Query:="@outline.Width = {0mm}")
  If SRTemp Is Nothing Then Exit Sub
  Set gsr = ActivePage.SelectableShapes.FindShapes(, cdrGroupShape)
  SRTemp.RemoveRange gsr
  SRTemp.Shapes.All.SetOutlineProperties 1
End Sub

Sub UmrissNull(Optional x As Boolean)
  If SRTemp Is Nothing Then Exit Sub
  SRTemp.Shapes.All.SetOutlineProperties 0
  Set SRTemp = Nothing
End Sub

Das klappt auch scheinbar, aber nur einmal, wenn ich dann andere Objekte auswähle, einfärbe und das RGB-Makro mal zwischendurch, dann geht es nicht mehr.

Code:

Dim SRTemp As ShapeRange

Sub sucheRBGoutline()
  Call UmrissZeigen
 
  ActivePage.SelectableShapes.FindShapes(Query:="@outline.Color.Type = 'rgb'").CreateSelection
  Call UmrissNull
End Sub



Sub UmrissZeigen(Optional x As Boolean)
  Dim gsr As ShapeRange
  ActiveDocument.Unit = cdrMillimeter
  Set SRTemp = ActivePage.SelectableShapes.FindShapes(Query:="@outline.Width = {0mm}")
  If SRTemp Is Nothing Then Exit Sub
  Set gsr = ActivePage.SelectableShapes.FindShapes(, cdrGroupShape)
  SRTemp.RemoveRange gsr
  SRTemp.Shapes.All.SetOutlineProperties 1
End Sub

Sub UmrissNull(Optional x As Boolean)
  If SRTemp Is Nothing Then Exit Sub
  SRTemp.Shapes.All.SetOutlineProperties 0
  Set SRTemp = Nothing
End Sub

Das heißt: Kann ich das Makro, wenn ich es so aufteile wie oben, dann aber immerhin 1x richtig ausführen? Das würde mir auch ausreichen. Ich würde dann einfach das Dokument neu öffnen und eben einmal das eine oder das andere Makro ausführen.

[koter]

Hallo Asterix,

...ob man am Ende eine Meldung bringen kann, wenn nichts gefunden wurde?...

Füge als letzte Zeile (nach: Call UmrissNull) folgenden Code ein:
If ActiveSelectionRange.Count = 0 Then MsgBox "Keine Objekte gefunden!", vbInformation, "Nichts Ausgewählt"

...Ich würde dann einfach das Dokument neu öffnen und eben einmal das eine oder das andere Makro ausführen.

Ich muss das Dokument nicht neu öffnen, bei mir (X7) funktionieren Deine Makros aus dem zitierten Beitrag immer!
Ich kann Dir also leider nicht sagen, was bei dir falsch läuft.

Gruß

Koter

[asterix]

Danke nochmals, die Meldung klappt!

Bei den von mir aufgeteilten Makros ist es nun so, dass sie immer klappen, wenn ein Umriss eine Angabe hat, also > 0 ist. Auch klappen beide, wenn ein CMYK-Umriss = 0 ist. 

Aber wenn im gleichen Dokument z.B. zwei Rechtecke sind, einmal RGB Umriss und einmal CMYK Umriss, und ich stelle den RGB-Umriss auf 0, dann findet das CMYK-Makro diesen, und das RGB-Makro findet nichts mehr.

Da es mir v.a. um CMYK-Umrisse geht, wäre das auch so ok, aber wie immer will man dann doch die Sache lösen.

[koter]

Hallo Asterix,

...aber wie immer will man dann doch die Sache lösen. ...

Aber Sicher! 

Es sieht so aus, als wären wir auf einen Bug gestoßen.

Du kannst folgenden Code probieren:

Code:

Sub sucheRBG()
   ActivePage.SelectableShapes.FindShapes(Query:="@fill.Color.Type = 'rgb'").CreateSelection
   ActivePage.SelectableShapes.FindShapes(Query:="@com.Style.Outline.Color.Type = 5").AddToSelection
   If ActiveSelectionRange.Count = 0 Then MsgBox "Keine RBG-Objekte gefunden!", vbInformation, "Nichts Ausgewählt"
End Sub

Sub sucheCMYK()
   ActivePage.SelectableShapes.FindShapes(Query:="@fill.Color.Type = 'cmyk'").CreateSelection
   ActivePage.SelectableShapes.FindShapes(Query:="@com.Style.Outline.Color.Type = 2").AddToSelection
   If ActiveSelectionRange.Count = 0 Then MsgBox "Keine CMYK-Objekte gefunden!", vbInformation, "Nichts Ausgewählt"
End Sub

Sub sucheRBGFill()
   ActivePage.SelectableShapes.FindShapes(Query:="@fill.Color.Type = 'rgb'").CreateSelection
   If ActiveSelectionRange.Count = 0 Then MsgBox "Keine RBG-Füllung gefunden!", vbInformation, "Nichts Ausgewählt"
End Sub

Sub sucheCMYKFill()
   ActivePage.SelectableShapes.FindShapes(Query:="@fill.Color.Type = 'cmyk'").CreateSelection
   If ActiveSelectionRange.Count = 0 Then MsgBox "Keine CMYK-Füllung  gefunden!", vbInformation, "Nichts Ausgewählt"
End Sub

Sub sucheCMYKoutline()
 ActivePage.SelectableShapes.FindShapes(Query:="@com.Style.Outline.Color.Type = 2").CreateSelection
 If ActiveSelectionRange.Count = 0 Then MsgBox "Keinen CMYK-Umriss gefunden!", vbInformation, "Nichts Ausgewählt"
End Sub

Sub sucheRBGoutline()
 ActivePage.SelectableShapes.FindShapes(Query:="@com.Style.Outline.Color.Type = 5").CreateSelection
 If ActiveSelectionRange.Count = 0 Then MsgBox "Keinen RBG-Umriss gefunden!", vbInformation, "Nichts Ausgewählt"
End Sub

Falls Du Einzelheiten zum Bug wissen willst, gib Bescheid.

Gruß

Koter

[asterix]

Vielen Dank, genau so klappt es nun !
Ich kenne mich nicht aus und würde daher zu deinem Bug nicht viel verstehen, höchstens es ist für andere auch interessant.

Nur noch die Frage, wann die Meldung "Nichts ausgewählt" kommen würde? In meinem (kurzen) Test kam ja entweder eine Auswahl oder eben, dass nichts gefunden wurde.

Ist aber nur eine Bonus-Frage, das Makro klappte gerade im Test super!