Масштабирование множества объектов

[igor_s]

Добрый день всем!
Делаю эскиз печати, на ее поле расположен массив элементов защиты (около 1000). Возникла необходимость отмасштабировать их все - но не группой, а чтобы центр каждого элемента не изменил своего местоположения). Есть ли такие команды/скрипты?

Спасибо.

 

[Asmussen]

Ответ: Масштабирование множества объектов

Вот набросал скриптик.
Выберите объекты, запустите Test и укажите процент масштабирования.

Dim Percent
Sub Test()
    ActiveDocument.ReferencePoint = cdrCenter
    If ActiveSelection.Shapes.Count = 0 Then MsgBox "Ничего не выбрано": End
    Percent = InputBox("Resize %")
    If Val(Percent) = 0 Then MsgBox "Введите цифры": End
    Find ActiveSelection.Shapes
End Sub

Private Sub Find(SS As Shapes)
Dim S As Shape, X As Double, Y As Double

For Each S In SS
    If S.Type = cdrGroupShape Then
        Find S.Shapes
    Else
        S.GetSize X, Y
        S.SetSize X * (Val(Percent) / 100)
    End If
Next S
End Sub

 

[lev]

Ответ: Масштабирование множества объектов

Вот ещё немножко:
http://www.isocalc.com/cooltools/transit.htm - EXE
http://kir-arts.narod.ru/Transform.html - VBA
http://www.oberonplace.com/draw/drawscripts/transformsh.htm - CorelSCRIPT

 

[igor_s]

Ответ: Масштабирование множества объектов

Cпасибо всем!
Конструкцию Asmussen'а уже не стал пробовать, поскольку Lev прислал полный джентельменский набор
Попробовал все, но не все завелось. Утилита фирмы isocalc - работает на всех версиях Corel до 10-й включительно. Обероновский скрипт не пошел (видимо потому что пробовал его на 11-й версии Corel'а. зато VBA-шный скрипт попыхтел минуты 3 и таки все сделал. Думаю, что и предыдущие варианты можно было бы использовать, понизив версию файла или подредактировав скрипт, но наверное не в этот раз.

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

Еще раз спасибо, задача выполнена!

 

[lev]

Ответ: Масштабирование множества объектов

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

Заменить X в конструкции вида CorelDRAW.Automation.X на текущую версию, для скриптов от CorelDRAW 8 и ранее, потребуются дополнительные телодвижения.

 

[wOxxOm]

Ответ: Масштабирование множества объектов

Кстати может было может нет, но я давно еще сделал скрипт который повторяет последний трансформ (сделанный мышкой или через Alt-F7,Alt-F8 и т.д. докер) над любом количеством выбранных объектов. Причем показывает прогресс в статус-строке CorelDraw

1. Берем один объект, делаем ему увеличение/уменьшение/поворот/зеркало
2. Выделяем любое количество новых объектов и запускаем макрос

Sub ForEach()
   Dim sr As ShapeRange, s As Shape, cnt&, i&, stat as AppStatus
   Set sr = ActiveSelectionRange: cnt = sr.Count: i = 1
   Optimization = True
   EventsEnabled = False
   ActiveDocument.SaveSettings
   ActiveDocument.PreserveSelection = False
   On Error Resume Next
   Set stat = Application.Status: stat.BeginProgress CanAbort:=True
   For Each s In sr
      If s.Selectable Then s.CreateSelection: ActiveDocument.Repeat
      i = i + 1: stat.Progress = i / cnt * 100
      stat.SetProgressMessage "Repeating..." & Str(i) & " / " & Str(reps)
      If stat.Aborted Then MsgBox "Command repeated " & Str(i) & " times": Exit For
   Next
   ActiveDocument.RestoreSettings
   EventsEnabled = True
   Optimization = False
   
   sr.CreateSelection
   ActiveWindow.ActiveView.ToFitSelection
End Sub

Можно использовать любой повторимый через Ctrl-R трансформ
Недостаток этого макроса в том, что ввиду невозможности поворять команду внутри блока BeginCommandGroup/EndCommandGroup, пришлось пожертвовать возможностью отмены для всего массива обработанных объектов. После запуска этого макроса в списке Undo остануться только последние 20-50 повторов (в зависимости от количества уровней Undo в опциях CorelDraw).
Достоинство макроса - в относительной универсальности и отсутствие вопросов к пользователю, а также высокая скорость работы благодаря использованию оптимизирующих команд