[CDR 2023] Сохранить группировку объектов.

[tohaa]

Добрый день.
Мой макрос перекрашивает выбранные элементы в цвета пантон, но приходится разгруппировывать всё выделение.

Dim s As shape
Dim sr As New ShapeRange

    Set sr = ActiveSelectionRange

    sr.UngroupAll

    If sr.Count = 0 Then
    MsgBox "Nothing selected!"
    Exit Sub
    End If

    For Each s In sr.Shapes
  
 If Not s.Fill.UniformColor.IsSpot Then
   
        If Not s.Fill.Type = cdrNoFill Then
        s.Fill.UniformColor.ConvertToFixed cdrPANTONECoated
        End If
       
        If Not s.Outline.Type = cdrNoOutline Then
        s.Outline.color.ConvertToFixed cdrPANTONECoated
        End If
 
End If
    Next s

Как сохранить структуру группировки выделения, но при этом перекрасить объекты?

 

[jam]

В каком виде у вас элементы, это несколько групп или одна группа? Внутри групп могут быть подгруппы?

Если одна группа, то в конце добавить:

Set sGroup = sr.Group

Для других случаев посложнее, конечно, надо подумать.

 

[jam]

Если просто несколько групп, то вот так можно попробовать:

Dim s, s2 As Shape
Dim sr, sr2 As ShapeRange

Set sr = ActiveSelectionRange

    For Each s In sr.Shapes
        s.Ungroup
        Set sr2 = ActiveSelectionRange
        For Each s2 In sr2.Shapes
            If Not s2.Fill.UniformColor.IsSpot Then
  
                If Not s2.Fill.Type = cdrNoFill Then
                    s2.Fill.UniformColor.ConvertToFixed cdrPANTONECoated
                End If
      
                If Not s2.Outline.Type = cdrNoOutline Then
                    s2.Outline.Color.ConvertToFixed cdrPANTONECoated
                End If
 
            End If
        Next s2
        Set sGroup = sr2.Group
    Next s

 

[tohaa]

В каком виде у вас элементы, это несколько групп или одна группа? Внутри групп могут быть подгруппы?

Если одна группа, то в конце добавить:

Set sGroup = sr.Group

Для других случаев посложнее, конечно, надо подумать.

В выделении может быть несколько несгруппированных объектов, а также группы с подгруппами

 

[DukereD]

а зачем разгруппировывать.
Просто выбираете все объекты как объекты внутри групп и всё. и с ними делаете что хотите и они остаются на своих местах

Set sr = ActiveSelectionRange.Shapes.FindShapes(query:="@type!='group'", Recursive:=True)

можно в query еще добавить условие на проверку цвета, но это надо штудировать мануал по CQL

вот этот мне показался чуть более информативным чем родной в справке корела

Corel Query Language

 

[tohaa]

Спасибо! Работает как надо. Высший пилотаж )

 

[DukereD]

Спасибо! Работает как надо. Высший пилотаж )

я как с недавних пор начал познавать CQL так все макросы потихоньку перевожу на выборку через этот запрос.
Очень удобно, а главное намного быстрее и во многих случаях можно вообще обойтись без пробегания по куче объектов, проверяя их свойства если правильно запрос поставить

вот такую функцию состряпал и теперь тыкаю куда только можно её ))

Public Function do_query(SS As Shapes, query, Optional ingroup = False)
    If ingroup Then query = query & " and @type!='group'"
    Set sr = ActiveSelectionRange
    sr.RemoveAll
    If InStr(1, query, "curve") > 0 Then
        Set SS = SS.FindShapes(query:="@com.type>0 and @com.type<5", Recursive:=ingroup).Shapes
    End If
    On Error Resume Next
    Set sr = SS.FindShapes(query:=query, Recursive:=ingroup)
    Set do_query = sr
End Function

 

[dimastyj]

а зачем разгруппировывать.
Просто выбираете все объекты как объекты внутри групп и всё. и с ними делаете что хотите и они остаются на своих местах

Set sr = ActiveSelectionRange.Shapes.FindShapes(query:="@type!='group'", Recursive:=True)

можно в query еще добавить условие на проверку цвета, но это надо штудировать мануал по CQL

вот этот мне показался чуть более информативным чем родной в справке корела

Corel Query Language

Подскажите а к слоям можно такие запросы делать?

 

[DukereD]

Подскажите а к слоям можно такие запросы делать?

нет. это свойство (функция) именно набора Shapes

 

[dimastyj]

нет. это свойство (функция) именно набора Shapes

Спасибо

 

[DukereD]

Подскажите а к слоям можно такие запросы делать?

а что именно вы хотите делать со слоями?

 

[dimastyj]

а что именно вы хотите делать со слоями?

ну например включать и отключать по цвету пиктограммы слоя или по номеру слоя, но если по номеру то его надо будет отделять от названия как то

 

[DukereD]

ну например включать и отключать по цвету пиктограммы слоя или по номеру слоя, но если по номеру то его надо будет отделять от названия как то

номер слоя это его индекс (порядок от 1 до ActiveDocument.Pages.Count)
к названию он не имеет отношения.
а обращаться можно или по индексу или по названию

 

[dimastyj]

номер слоя это его индекс (порядок от 1 до ActiveDocument.Pages.Count)
к названию он не имеет отношения.
а обращаться можно или по индексу или по названию

я наверное неправильно написал, в названиях слоев идет нумерация, например: "2.1 обьекты..."

 

[DukereD]

я наверное неправильно написал, в названиях слоев идет нумерация, например: "2.1 обьекты..."

ну тут отделить не сложно.
если страниц до 10 те.. X.Y формат, то просто через MID можно отловить
если формат записи чуть сложней, то можно через SPLIT по пробелу

 

[dimastyj]

Спасибо, я как то так в принципе и думал