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

tohaa

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

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

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

tohaa

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

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

tohaa

Участник
Топикстартер
Сообщения
229
Реакции
8
Готово. Работает как надо.

Код:
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

Всем спасибо.
 
  • Спасибо
Реакции: DukereD

dastin

Некромант-любитель
12 лет на форуме
Сообщения
2 131
Реакции
2 027
Работает как надо.
в группах искать не будет
...
как насчет такого?


Код:
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
 
  • Спасибо
Реакции: mnemonix и tohaa

dastin

Некромант-любитель
12 лет на форуме
Сообщения
2 131
Реакции
2 027
можно на этом
несколько вложенных групп
версия-16
 

Вложения

  • dot-dash.zip
    1.3 МБ · Просм.: 132

tohaa

Участник
Топикстартер
Сообщения
229
Реакции
8
в группах искать не будет
...
как насчет такого?


Код:
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

макрософил
Сообщения
459
Реакции
112

DukereD

макрософил
Сообщения
459
Реакции
112
а так
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