[CDR 2017-2021] Найти все пунктиры на странице и сделать сплошными.

[tohaa]

Добрый день.
На странице расположен сложный векторный рисунок. Множество объектов. С обводками или без.
Хочу найти все объекты с пунктирной обводкой и изменить пунктир на сплошную линию. Остальных свойств не меняя.

Записанный рекордером макрос переделать не получается.

Sub Macro7()
Dim Sh As Shape
For Each Sh In ActiveSelectionRange.Shapes
    Sh.Style.StringAssign "{""outline"":{""dashDotSpec"":""0""},,""transparency"":{}}"
Next Sh
End Sub

 

[tohaa]

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

Sub Macro7()
Dim Sh As Shape
For Each Sh In ActiveSelectionRange.Shapes
    Sh.Outline.SetProperties Style:=OutlineStyles(0)
Next Sh
End Sub

 

[tohaa]

Готово. Работает как надо.

Sub dash_to_line()
Dim Sh As Shape
For Each Sh In ActiveSelectionRange.Shapes
If Not Sh.Outline.Type = cdrNoOutline Then Sh.Outline.SetProperties Style:=OutlineStyles(0)
Next Sh
End Sub

Всем спасибо.

 

[dastin]

Работает как надо.

в группах искать не будет
...
как насчет такого?

Sub dash_to_line()
Dim sh As ShapeRange, s As Shape
Set sh = ActiveSelectionRange.Shapes.FindShapes(Query:="@outline[.type = 'dot-dash']")
For Each s In sh
s.Outline.SetProperties Style:=OutlineStyles(0)
Next s
End Sub

 

[DukereD]

Set sh = ActiveSelectionRange.Shapes.FindShapes(Query:="@outline[.type = 'dot-dash']")

FindShapes залазит в группы?

 

[dastin]

FindShapes залазит в группы?

что-то мешает проверить?

 

[dastin]

можно на этом
несколько вложенных групп
версия-16

 

[tohaa]

в группах искать не будет
...
как насчет такого?

Sub dash_to_line()
Dim sh As ShapeRange, s As Shape
Set sh = ActiveSelectionRange.Shapes.FindShapes(Query:="@outline[.type = 'dot-dash']")
For Each s In sh
s.Outline.SetProperties Style:=OutlineStyles(0)
Next s
End Sub

Идеально.

 

[DukereD]

что-то мешает проверить?

поиск по цвету почему-то не всегда находит именно через findshapes запрос типа @fill.color=cmyk(95,95,45,95)

 

[dastin]

findshapes

а так
ActivePage.Shapes.FindShapes(Query:="@fill.color = cmyk(95,95,45,95)").CreateSelection
?

 

[DukereD]

а так
ActivePage.Shapes.FindShapes(Query:="@fill.color = cmyk(95,95,45,95)").CreateSelection
?

да. примерно такой код и есть. но не на всех объектах срабатывает. подозреваю что объект был импортирован из другого файла (редактора) поэтомоу может быть. на созданных в этом кореле вроде не было замечено глюков.

        ActiveDocument.ClearSelection
        Set f_fil = ss.FindShapes(Query:=qry_all)
        sr.AddRange f_fil
        sr.CreateSelection