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

[_MBK_]

Объявите s1 - не Shape - но ShapeRange

Да щас

Function Group() As Shape

 

[eugeny]

Скрипт рабочий. У меня была такая фигня — перезапустите Корел.

 

[_MBK_]

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

Возможно, на каком то слое нет обьектов вообще

 

[dastin]

перезапустите Корел

... давайте лучше не будем ...

из всех слоёв для каждой из страниц документа останется
один слой с поименованными группами (названиями слоёв)
заблокированные слои останутся как есть
заблокированные объекты будут разблокированы
оставшиеся пустые слои будут удалены

Sub cmbML()
Dim pg As Page, lyr As Layer, Nlyr As String
Dim sr As ShapeRange, Asr As New ShapeRange, Lsr As Shape
Dim srNE As New ShapeRange
    Optimization = True
    EventsEnabled = False
    ActiveDocument.BeginCommandGroup "Merge_Layers"

For Each pg In ActiveDocument.Pages
pg.Activate
    For Each lyr In pg.Layers
    lyr.Activate
        If lyr.IsSpecialLayer = False Then
        If lyr.Editable = False Then GoTo nonE:
            Nlyr = lyr.Name
        Set srNE = lyr.Shapes.FindShapes(Query:="@com.locked = 'true'")
        srNE.Unlock
        Set sr = lyr.Shapes.All
            If sr.Count <> 0 Then
            Set Lsr = sr.Group
            Lsr.Name = Nlyr
            Asr.Add Lsr
            Else
            lyr.Delete
            End If
        End If
nonE:
    Next
    Asr.Group
    Asr.RemoveAll
  
    For Each lyr In pg.Layers
    lyr.Activate
        If lyr.IsSpecialLayer = False Then
        Set sr = lyr.Shapes.All
            If sr.Count = 0 Then
            lyr.Delete
            End If
        End If
    Next
Next

    ActiveDocument.EndCommandGroup
   Application.FrameWork.Automation.Invoke "3be0149d-d861-4fcf-ba5b-724554af2376"
   Application.FrameWork.Automation.Invoke "e6627fc9-9497-4ca9-b3ac-808b91666131"
   DoEvents
    EventsEnabled = True
    Optimization = False
    Refresh
End Sub

 

[_MBK_]

Application.FrameWork.Automation.Invoke "3be0149d-d861-4fcf-ba5b-724554af2376" Application.FrameWork.Automation.Invoke "e6627fc9-9497-4ca9-b3ac-808b91666131" DoEvents

А эта хрень точно в любом кореле работать будет?

 

[Nameless950]

Возможно, на каком то слое нет обьектов вообще

Да, дело в этом было. Спасибо. Теперь работает. Всем спасибо. Второй код тоже попробую, посмотрю как работает.

 

[dastin]

в любом кореле

тема - CDR 2017-2020 - ​

это переключение режимов показа - в диспетчере объектов - иначе отображение залипает

 

[DukereD]

Application.FrameWork.Automation.Invoke "3be0149d-d861-4fcf-ba5b-724554af2376"
Application.FrameWork.Automation.Invoke "e6627fc9-9497-4ca9-b3ac-808b91666131"

А тут что происходит?

 

[dastin]

А тут что происходит?

переключение отображения страниц и слоёв - туда и обратно - для обновления информации
в старых и последних версиях

 

[DukereD]

переключение отображения страниц и слоёв - туда и обратно - для обновления информации
в старых и последних версиях

Посмотреть вложение 151829Посмотреть вложение 151831

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

 

[dastin]

а может

Sub Ratio()
Application.FrameWork.Automation.InvokeItem "d289f32b-3808-4510-b892-fd2cb0820209"
ActiveWindow.Refresh
Application.Refresh
End Sub