[CDR 2017-2021] Сгруппировать объекты по слоям с именем соответствующих слоев

[Nameless950]

Приветствую. Подскажите, пожалуйста, можно ли стандартными средствами сгруппировать объекты в каждом слое в группы с названием этого слоя?
Если нет, то можно ли это решить макросом?
*Дополнительно хотелось бы еще обрезать эти объекты по рамке через стандартную функцию "пересечение", но, кажется, это можно реализовать путем обрезания группы этих объектов и никакие сложные макросы для этого уже не будут нужны

 

[_MBK_]

Можно конечно
А что прям настолько много слоев что руками это сделать сложно?

 

[Nameless950]

Можно конечно
А что прям настолько много слоев что руками это сделать сложно?

Достаточно для того, чтобы захотеть автоматизировать это действие.
А подсказать макрос можете?

 

[_MBK_]

Достаточно для того, чтобы захотеть автоматизировать это действие.
А подсказать макрос можете?

Ну могу подсказать направление. Поставьте на запись - заблокируйте все слои кроме нужного - выделите все обьекты в документе - сгруппируйте и.т.д Потом посмотрите что записалось и допилите напильником

 

[Nameless950]

допилите напильником

К сожалению пока получается только использовать готовые макросы. Пока не разобрался в логике, только начинаю изучать макросы в CorelDraw. Так что пока "напильника" не имеется. Записать попробовал, а понять что записалось не очень получается. Опять же он мне записал в имя конкретное слово, которое я скопировал из имени слоя, а я думал, что будет указана ссылка на то, откуда я копировал. Пока что сложно дается самостоятельное написание макросов.

 

[_MBK_]

К сожалению пока получается только использовать готовые макросы. Пока не разобрался в логике, только начинаю изучать макросы в CorelDraw. Так что пока "напильника" не имеется. Записать попробовал, а понять что записалось не очень получается. Опять же он мне записал в имя конкретное слово, которое я скопировал из имени слоя, а я думал, что будет указана ссылка на то, откуда я копировал. Пока что сложно дается самостоятельное написание макросов.

Ну это как раз не проблема.
Постите свой вариант макроса, говорите какая именно проблема, по мере сил поможем ее решить.
Возможно в какой то момент у кого то из присутствующих не выдержат нервы и он вам готовый целиком сделает, задача простецкая.

 

[Nameless950]

Sub gr()
    ' Recorded 18.05.2022
    ActiveLayer.Editable = True
    ActiveLayer.Shapes.All.CreateSelection
    Dim s1 As Shape
    Set s1 = ActiveSelection.group
    s1.ObjectData("Name").Value = "iso"
End Sub

-
Полагаю макрос сперва разблокирует слой, дальше выделяет всё на этом слое, группирует, задает имя указанное в кавычках. Нужно же, чтобы имя было задано именем слоя (как правильно написать в коде? LayerName?), а также зациклить разблокировку последующих слоев и повторить всё по кругу.

 

[_MBK_]

s1.name = ActiveLayer.name
Если мне не изменяет мой склероз

 

[Nameless950]

s1.name = ActiveLayer.name
Если мне не изменяет мой склероз

Так, один слой он мне группирует и называет. А как это всё запустить циклом по всем слоям?

 

[_MBK_]

Так, один слой он мне группирует и называет. А как это всё запустить циклом по всем слоям?

For i=1 to ActiveDocument.Layers.count
ActiveLayer=ActiveDocument.Layers ( i )
...
Next i

 

[_MBK_]

Только внутри этого цикла, естественно, другой цикл блокирцющий все слои

 

[Nameless950]

For i=1 to ActiveDocument.Layers.count
ActiveLayer=ActiveDocument.Layers ( i )
...
Next i

Sub gr()
    For i = 1 To ActiveDocument.Layers.Count
    ActiveLayer = ActiveDocument.Layers(i)
    ActiveLayer.Editable = True
    ActiveLayer.Shapes.All.CreateSelection
    Dim s1 As Shape
    Set s1 = ActiveSelection.group
    s1.Name = ActiveLayer.Name
    Next i
End Sub

В таком коде ругается на первую строчку ( For i = 1 To ActiveDocument.Layers.Count), пишет ошибка 438 (Объект не поддерживает это свойство или метод (ошибка 438))

 

[_MBK_]

Наверное все таки ActiveDocument.ActivePage.Layers

 

[Nameless950]

Наверное все таки ActiveDocument.ActivePage.Layers

Всё равно не берет первую строчку. Теперь ошибка 450.

 

[dastin]

Всё равно не берет

попробуйте так

For Each pg In ActiveDocument.Pages
pg.Activate
    For Each lyr In pg.Layers
    lyr.Activate
        If lyr.IsSpecialLayer = False Then
        ...
    Next lyr
Next pg

 

[Nameless950]

попробуйте так

For Each pg In ActiveDocument.Pages
pg.Activate
    For Each lyr In pg.Layers
    lyr.Activate
        If lyr.IsSpecialLayer = False Then
        ...
    Next lyr
Next pg

Sub gr()
    For Each pg In ActiveDocument.Pages
    pg.Activate
    For Each lyr In pg.Layers
    lyr.Activate
        If lyr.IsSpecialLayer = False Then
        ActiveLayer.Editable = True
        ActiveLayer.Shapes.All.CreateSelection
        Dim s1 As Shape
        Set s1 = ActiveSelection.group
        s1.Name = ActiveLayer.Name
        ActiveLayer.Editable = False
    Next lyr
Next pg
End Sub

Тут ругается на Next lyr, пишет, что next без for, хотя for есть выше, либо я снова не разобрался в синтаксисе

 

[eugeny]

Sub gr()
    For Each pg In ActiveDocument.Pages
    pg.Activate
    For Each lyr In pg.Layers
    lyr.Activate
        If lyr.IsSpecialLayer = False Then
        ActiveLayer.Editable = True
        ActiveLayer.Shapes.All.CreateSelection
        Dim s1 As Shape
        Set s1 = ActiveSelection.group
        s1.Name = ActiveLayer.Name
        ActiveLayer.Editable = False
    Next lyr
Next pg
End Sub

Тут ругается на Next lyr, пишет, что next без for, хотя for есть выше, либо я снова не разобрался в синтаксисе

у вас для If оператора Endif потерян. Поэтому If присваивает себе Next, а for ничего не остается

 

[_MBK_]

Sub gr()
    For Each pg In ActiveDocument.Pages
    pg.Activate
    For Each lyr In pg.Layers
    lyr.Activate
        If lyr.IsSpecialLayer = False Then
        ActiveLayer.Editable = True
        ActiveLayer.Shapes.All.CreateSelection
        Dim s1 As Shape
        Set s1 = ActiveSelection.group
        s1.Name = ActiveLayer.Name
        ActiveLayer.Editable = False
    Next lyr
Next pg
End Sub

Тут ругается на Next lyr, пишет, что next без for, хотя for есть выше, либо я снова не разобрался в синтаксисе

Перед next lyr вставьте endif

 

[Nameless950]

Перед next lyr вставьте endif

Поставил, пишет ошибку 91 и указывает теперь на строчку s1.Name = ActiveLayer.Name

Sub gr2()
    For Each pg In ActiveDocument.Pages
    pg.Activate
    For Each lyr In pg.Layers
    lyr.Activate
        If lyr.IsSpecialLayer = False Then
        ActiveLayer.Editable = True
        ActiveLayer.Shapes.All.CreateSelection
        Dim s1 As Shape
        Set s1 = ActiveSelection.Group
        s1.Name = ActiveLayer.Name
        ActiveLayer.Editable = False
        End If
    Next lyr
Next pg
End Sub

 

[dastin]

пишет ошибку 91

потому что
Set s1 = ActiveSelection.Group
а ActiveSelection кто будет создавать? Ничего не выделено и имени у этого ничегоневыделенного тоже нет
... хотя наврал - не так
Объявите s1 - не Shape - но ShapeRange