помогите с макросом 2 инверсия цвета

[Linotronic]

Оч. нужен еще один макрос. Пытался что-то состряпать на основе предыдущего (они оч. похожи) не получилось((

Выделяем контур

1. Копирование бъекта (квадрат-круг)
2. Увеличение копии по X и Y на 5 мм.
3. Задание ему черной заливки.
3. Выделение всего что внутри
4. Перевод в кривые
5. Удаление объектов не имеющих обводки и заливки (это вообще не понял как реализовать. А без этого не работает п. 6)
6. Инверсия цвета (того что внутри. Увеличенный объект остается черным).

Вот что наковырял сам.

Sub res()  Dim Contur As Shape, Dup As Shape
      If Documents.Count = 0 Then Exit Sub
      If ActiveSelection.Shapes.Count <> 1 Then Exit Sub
      ActiveDocument.ReferencePoint = cdrCenter
      ActiveDocument.Unit = cdrMillimeter
      Set Contur = ActiveShape
      Set Dup = Contur.Duplicate
      Dup.SetSize Contur.SizeWidth + 5, Contur.SizeHeight + 5
      3. Задание ему черной заливки.
      ActivePage.SelectShapesFromRectangle Contur.LeftX, Contur.BottomY, Contur.RightX, Contur.TopY, False
      ActivePage.Shapes.All.ConvertToCurves
      5. Удаление объектов не имеющих обводки и заливки (это вообще не понял как реализовать. А без этого не работает п. 6 и в принципе инверсия)
      OrigSelection.ApplyEffectInvert (не работает-()
End Sub

Естественно у увеличенного объекта не получается заливки.
Переводит таки в кривые. И выдает ошибку со строкой инверсии (хотя и невидимых объектов нет) .

Помгите плз.

 

[Linotronic]

Ответ: помогите с макросом 2 инверсия цвета

И еще вопрос. Можно ли как-то реализовать рисование произвольного контура на определенном расстоянии/отступе от уже существующего по внешнему его краю. Что-то типа этого.

 

[ch_alex]

Ответ: помогите с макросом 2 инверсия цвета

Обычно округлые символы (С, О) обычно имеют бОльшую высоту, нежели остальные символы. Если дорисовать обводку макросом автоматически, то разница по высоте моментально станет заметной.

 

[Skvoznyak]

Ответ: помогите с макросом 2 инверсия цвета

И еще вопрос. Можно ли как-то реализовать рисование произвольного контура на определенном расстоянии/отступе от уже существующего по внешнему его краю. Что-то типа этого.

можно, и давно реализовано. Interactive Contour tool называется

 

[Linotronic]

Ответ: помогите с макросом 2 инверсия цвета

можно, и давно реализовано. Interactive Contour tool называется

Век живи — век учись. :-D
Спасибо.

Эх. Ну чтож с макросом то...(
Asmussen, где же вы...

 

[Sanchos]

Ответ: помогите с макросом 2 инверсия цвета

Не пойму для чего всё это, но вот пробуй (если я тебя правильно понял)...

Sub res()
 Dim s As Shape, Dup As Shape
 If Documents.Count = 0 Then Exit Sub
 If ActiveSelection.Shapes.Count <> 1 Then Exit Sub
 ActiveDocument.ReferencePoint = cdrCenter
 ActiveDocument.Unit = cdrMillimeter
 Set s = ActiveShape
 Set Dup = s.Duplicate
 Dup.SetSize s.SizeWidth + 5, s.SizeHeight + 5
 Dup.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
 ActivePage.SelectShapesFromRectangle s.LeftX, s.BottomY, s.RightX, s.TopY, False
 ActivePage.Shapes.All.ConvertToCurves
 For Each s In ActivePage.Shapes
 If s.Fill.Type = cdrNoFill And s.Outline.Width = 0 Then s.Delete
 Next
End Sub

 

[Asmussen]

Ответ: помогите с макросом 2 инверсия цвета

Эх. Ну чтож с макросом то...(
Asmussen, где же вы...

К сожалению не всегда есть время чтобы отвечать на форуме.
Вижу что, Sanchos уже ответил, решил все равно написать.
Вы делали все правильно, только окривлять надо не все объекты на странице, а то что у нас выделено. И чтобы инверсия прошла нормально, не обязательно удалять объекты не имеющие обводки и заливки, в данном случае можно просто проигнорировать ошибку. Вот что получится.

Sub res2()
Dim Contur As Shape, Dup As Shape
 If Documents.Count = 0 Then Exit Sub
 If ActiveSelection.Shapes.Count <> 1 Then Exit Sub
 ActiveDocument.ReferencePoint = cdrCenter
 ActiveDocument.Unit = cdrMillimeter
 Set Contur = ActiveShape
 Set Dup = Contur.Duplicate
 Dup.SetSize Contur.SizeWidth + 5, Contur.SizeHeight + 5
 Dup.Fill.ApplyUniformFill Color:=CreateCMYKColor(0, 0, 0, 100)
 ActivePage.SelectShapesFromRectangle Contur.LeftX, Contur.BottomY, Contur.RightX, Contur.TopY, False
 ActiveSelection.ConvertToCurves
 On Error Resume Next
 ActiveSelection.ApplyEffectInvert
End Sub

 

[Linotronic]

Ответ: помогите с макросом 2 инверсия цвета

спасибо большое!