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

[tohaa]

Здравствуйте.

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

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

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

Понимаю, что макрос простой, но знаний для его написания у меня недостаточно.
Помогите пожалуйста.

 

[_MBK_]

А зачем макрос? Все штатными средствами решается

 

[tohaa]

А зачем макрос? Все штатными средствами решается
Посмотреть вложение 138253

Да. Я конечно же знаю об этих функциях, но когда речь идет о экономии секунд на обработку нужен макрос.

 

[_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]

Все равно не пойму суть проблемы - записываете, равняете и получаете код:

Sub Macro1()
    ' Recorded 27.11.2020
    Dim OrigSelection As ShapeRange
    Set OrigSelection = ActiveSelectionRange
    OrigSelection.AlignAndDistribute cdrAlignDistributeHDistributeSpacing, cdrAlignDistributeVNone, cdrAlignShapesToLastSelected, cdrDistributeToSelection, False, cdrTextAlignBoundingBox
End Sub

который допиливает напильником под свои особенности

А как сделать отступ от объекта? Как получить размеры объекта? Как сделать по два в столбик?

 

[_MBK_]

А как сделать отступ от объекта?

Посчитать суммарную ширину всех объектов, прибавить отступы и раздвинуть, потом применить.

Как получить размеры объекта?

obj.SizeWidth

Как сделать по два в столбик?

Брр вам по высоте или по ширине распределить?
Разбейте на две примерно равные группы и к каждой примените выравнивание сдвинув относительно друг друга

 

[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

 

[_MBK_]

Чтобы каждый раз с калькулятором не пересчитывать дюймы в миллиметры, лучше поставить так:

ActiveDocument.Unit = cdrMillimeter
space_dist= 5

 

[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

Большое спасибо. Это почти то что я искал! Чуть доделать и полетит!)

 

[design_rm]

Большое спасибо. Это почти то что я искал! Чуть доделать и полетит!)

есть еще такое за 10 баксов Dizzy Shaping Version 4 – macromonster.com , а также где-то на форуме бесплатно старая версия dizzy shaping (32 бит)

 

[_MBK_]

dizzy нет прав на эти ( что на макромонстре размещены - CropMarker, Shaping, RasterControl) макросы - он их ( джентельменское соглашение) отдал Джефу Харрисону JH

 

[tohaa]

Уважаемые vba программисты, давайте немного разовьём выложенный выше скрипт и построим выделенные объекты в столбик по размеру)

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

Научите меня пожалуйста.

 

[_MBK_]

Sorting ShapeRange with multiple parameters - Code snippets feedback - Developer Area - CorelDRAW Community

community.coreldraw.com

 

[tohaa]

Sorting ShapeRange with multiple parameters - Code snippets feedback - Developer Area - CorelDRAW Community

community.coreldraw.com

Разобрался. Спасибо. Сортирует от большего к меньшему

выделенные объекты.Sort "@shape1.width*@shape1.height < @shape2.width*@shape2.height"

 

[_MBK_]

Разобрался. Спасибо. Сортирует от большего к меньшему

выделенные объекты.Sort "@shape1.width*@shape1.height < @shape2.width*@shape2.height"

А если по площади - не работает, ну типа такого?

@shape1.DisplayCurve.Area>@shape2.DisplayCurve.Area

 

[tohaa]

А если по площади - не работает, ну типа такого?

@shape1.DisplayCurve.Area>@shape2.DisplayCurve.Area

 

[_MBK_]

А хотя да в спецификации такого нет, значит через произведение