Makro-Nachhilfe für Funktionen für alle Objekte

[asterix]

Hallo Koter,

ok hab doch noch eine Abschlussrunde an Fragen.
Wie kann ich den folgenden Code ändern, damit er bei Kurven und auch bei Objekten geht (gefüllte Fläche, aber keine Rechtecke, sondern nur eben ehemalige Kurven, die ich zu Objekten konvertiert habe)? Wenn ich das Makro zum Smoothen einzeln ausführe, wie hier im Thread besprochen, dann geht es, aber im Gesamt-Makro nicht. Ich habe es mal hinbekommen zwischendurch, aber jetzt nicht mehr.

Code:

For Each sl In ActiveSelection.Shapes: sl.Curve.Nodes.All.Smoothen 20
Next

Und: wie kann ich in CorelDraw VBA die Windows-Zwischenablage leeren? Solange ich nichts drin habe (oder manuell in Windows lösche), ist mein Illustrator-Datei-Einfügen ok, aber wenn etwas drin ist, kopier er natürlich auch die Zwischenablage noch zusätzlich rein.

Da ich eher zu Smoothen tendiere, dürfte sich dann meine andere "letzte" Frage zum AutoReduce erledigt haben. Wie du auch schreibst, wird CorelDraw da noch etwas anderes machen, weil AutoReduce irgendwie deutlich weniger leicht zu nutzen ist als Smoothen, von den Ergebnissen her.

---
und hier der Vollständigkeit halber der Gesamtcode, es funktioniert alles bis auf die beiden Sachen, die ich gerade genannt habe.

Code:

Sub opencopy()
    ' Recorded 30.06.2024
    Dim lr1 As Layer
    Set lr1 = ActiveDocument.Pages(1).CreateLayer("Ebene 1")
    ' Recording of this command is not supported
    Dim impopt As StructImportOptions
    Set impopt = CreateStructImportOptions
    impopt.MaintainLayers = True
    Dim impflt As ImportFilter
    Set impflt = lr1.ImportEx("C:\objekt.ai", 1283, impopt)
    impflt.Finish
    Dim s1 As Shape
    Set s1 = ActiveShape
    Dim grp1 As ShapeRange
    Set grp1 = ActiveSelection.UngroupEx
    Dim openopt As StructOpenOptions
    Set openopt = CreateStructOpenOptions
    With openopt.ColorConversionOptions
        .SourceColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 300% (ECI),Dot Gain 15%"
        .TargetColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 300% (ECI),Dot Gain 15%"
    End With
    Dim doc1 As Document
    Set doc1 = OpenDocumentEx("C:\objekt.ai", openopt)
    ActivePage.SelectableShapes.All.CreateSelection
      ActiveSelection.Outline.SetProperties Color:=CreateRGBColor(0, 0, 0)
      ActiveSelection.Outline.SetProperties Width:=0
      ActiveSelection.Fill.ApplyUniformFill CreateRGBColor(0, 0, 0)
      For Each sl In ActiveSelection.Shapes: sl.Curve.Nodes.All.Smoothen 20
      Next
    grp1.Copy
    doc1.Close
    Dim pasteopt As StructPasteOptions
    Set pasteopt = CreateStructPasteOptions
    With pasteopt.ColorConversionOptions
        .SourceColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 300% (ECI),Dot Gain 15%"
        .TargetColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 300% (ECI),Dot Gain 15%"
    End With
    Dim Paste1 As ShapeRange
    Set Paste1 = ActiveDocument.Pages(1).Layers("Ebene 1").PasteEx(pasteopt)
End Sub