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

  • Автор темы Автор темы igor_s
  • Дата начала Дата начала
Статус
Закрыто для дальнейших ответов.
I

igor_s

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

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

Вот набросал скриптик.
Выберите объекты, запустите 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
 
Ответ: Масштабирование множества объектов

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

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

Еще раз спасибо, задача выполнена!
 
Ответ: Масштабирование множества объектов

что в ... скриптах нужно изменять, чтобы они шли на новых версиях программы
Нажмите, чтобы раскрыть...
Заменить X в конструкции вида CorelDRAW.Automation.X на текущую версию, для скриптов от CorelDRAW 8 и ранее, потребуются дополнительные телодвижения.
 
Ответ: Масштабирование множества объектов

Кстати может было может нет, но я давно еще сделал скрипт который повторяет последний трансформ (сделанный мышкой или через 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).
Достоинство макроса - в относительной универсальности и отсутствие вопросов к пользователю, а также высокая скорость работы благодаря использованию оптимизирующих команд
 
Статус
Закрыто для дальнейших ответов.
Верх Низ