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

[asterix]

Danke - ich denke, ich muss noch vorher die Knoten zu glatten Knoten (ggf. auch symmetrischen) machen. Wenn ich zuerst die (vielen) spitzen Knoten zu glatten mache und danach das Makro ausführe für Autoreduce, dann sieht es ähnlich aus wie beim CorelDraw-Knoten-Reduzieren, das scheint dort mit dabei zu sein, wenn auch nicht alle Knoten zu glatten gemacht werden. Aber nur "Autoreduce" ist da wohl nicht hinter der Schaltfläche.

Das Ändern des Knotentypen habe ich auch mit Aufnehmen eines Makros versucht, natürlich ohne Erfolg. Abschließend für die Nachhilfestunden würde ich mich daher freuen noch zwei Sachen zu lernen:
- Code, um die ausgewählten Knoten in glatt oder symmetrisch zu ändern
- bei Gelegenheit vielleicht die Korrektur folgenden Codes, der mir aus eine Illustrator-Datei eigentlich sehr schön etwas herauskopiert, aber leider im CDR dann zwei Mal einfügt - ich brauche es nur einmal.
 
Mehr fällt mir dann erstmal nicht ein bzw. ich habe dann ziemlich viel zu bearbeiten in den Dateien.

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)
    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