[CDR 2017-2021] Распределение объектов с одинаковым расстоянием между ними

  • Автор темы Автор темы tohaa
  • Дата начала Дата начала
T

tohaa

Участник
Топикстартер
Сообщения
247
Реакции
9
Здравствуйте.

Условие: Выделена группа объектов (импортированные перетаскиванием пдфки)

Задача: распределить выбранные объекты с равным расстоянием между ними (допустим 10 мм).
Желательно распределить объекты в два столбика (если возможно).

Объекты разного размера. Объектов при каждом импорте разное колво.

Понимаю, что макрос простой, но знаний для его написания у меня недостаточно.
Помогите пожалуйста.
 
А зачем макрос? Все штатными средствами решается
1606462673805.png
 
Все равно не пойму суть проблемы - записываете, равняете и получаете код:
Код: 
Sub Macro1()
    ' Recorded 27.11.2020
    Dim OrigSelection As ShapeRange
    Set OrigSelection = ActiveSelectionRange
    OrigSelection.AlignAndDistribute cdrAlignDistributeHDistributeSpacing, cdrAlignDistributeVNone, cdrAlignShapesToLastSelected, cdrDistributeToSelection, False, cdrTextAlignBoundingBox
End Sub
который допиливает напильником под свои особенности
 
_MBK_ сказал(а):
Все равно не пойму суть проблемы - записываете, равняете и получаете код:
Код: 
Sub Macro1()
    ' Recorded 27.11.2020
    Dim OrigSelection As ShapeRange
    Set OrigSelection = ActiveSelectionRange
    OrigSelection.AlignAndDistribute cdrAlignDistributeHDistributeSpacing, cdrAlignDistributeVNone, cdrAlignShapesToLastSelected, cdrDistributeToSelection, False, cdrTextAlignBoundingBox
End Sub
который допиливает напильником под свои особенности
Нажмите, чтобы раскрыть...
А как сделать отступ от объекта? Как получить размеры объекта? Как сделать по два в столбик?
 
tohaa сказал(а):
А как сделать отступ от объекта?
Нажмите, чтобы раскрыть...
Посчитать суммарную ширину всех объектов, прибавить отступы и раздвинуть, потом применить.
tohaa сказал(а):
Как получить размеры объекта?
Нажмите, чтобы раскрыть...
obj.SizeWidth
tohaa сказал(а):
Как сделать по два в столбик?
Нажмите, чтобы раскрыть...
Брр вам по высоте или по ширине распределить?
Разбейте на две примерно равные группы и к каждой примените выравнивание сдвинув относительно друг друга
 
у меня такое есть давно где-то нашел
Код: 
Sub space_it_right_horiz()
    Dim sr As ShapeRange
    Dim sr_counter As Long
    Const space_dist As Double = 0.19685
  
    Set sr = ActiveSelectionRange
  
    For sr_counter = sr.Count To 2 Step -1
        sr(sr_counter - 1).LeftX = sr(sr_counter).RightX + space_dist
    Next sr_counter
End Sub


Код: 
Sub space_it_right_vert()
    Dim sr As ShapeRange
    Dim sr_counter As Long
    Const space_dist As Double = 0.19685
  
    Set sr = ActiveSelectionRange
  
    For sr_counter = sr.Count To 2 Step -1
        sr(sr_counter - 1).TopY = sr(sr_counter).BottomY - space_dist
    Next sr_counter
End Sub

Горизонтальный и вертикальный. Где 0.19685 (дюймы) = 5мм, там уж свое подставить.
Не берет в расчет обводку и абрис. Забыл написать что Х6
 
Последнее редактирование:
  • Спасибо
Реакции: tohaa
Чтобы каждый раз с калькулятором не пересчитывать дюймы в миллиметры, лучше поставить так:
Код: 
ActiveDocument.Unit = cdrMillimeter
space_dist= 5
 
  • Спасибо
Реакции: tohaa и design_rm
design_rm сказал(а):
у меня такое есть давно где-то нашел
Код: 
Sub space_it_right_horiz()
    Dim sr As ShapeRange
    Dim sr_counter As Long
    Const space_dist As Double = 0.19685
 
    Set sr = ActiveSelectionRange
 
    For sr_counter = sr.Count To 2 Step -1
        sr(sr_counter - 1).LeftX = sr(sr_counter).RightX + space_dist
    Next sr_counter
End Sub


Код: 
Sub space_it_right_vert()
    Dim sr As ShapeRange
    Dim sr_counter As Long
    Const space_dist As Double = 0.19685
 
    Set sr = ActiveSelectionRange
 
    For sr_counter = sr.Count To 2 Step -1
        sr(sr_counter - 1).TopY = sr(sr_counter).BottomY - space_dist
    Next sr_counter
End Sub

Горизонтальный и вертикальный. Где 0.19685 (дюймы) = 5мм, там уж свое подставить.
Не берет в расчет обводку и абрис. Забыл написать что Х6
Нажмите, чтобы раскрыть...
Большое спасибо. Это почти то что я искал! Чуть доделать и полетит!)
 
Уважаемые vba программисты, давайте немного разовьём выложенный выше скрипт и построим выделенные объекты в столбик по размеру)

От большего к меньшему.

Научите меня пожалуйста.
 
tohaa сказал(а):
Разобрался. Спасибо. Сортирует от большего к меньшему
Код: 
выделенные объекты.Sort "@shape1.width*@shape1.height < @shape2.width*@shape2.height"
Нажмите, чтобы раскрыть...
А если по площади - не работает, ну типа такого?

@shape1.DisplayCurve.Area>@shape2.DisplayCurve.Area
 
Для ответа нужно войти/зарегистрироваться
Верх Низ