Макрос для придания всем фигурам на странице общей границы

Я использую CorelDraw X7. У меня есть страница, содержащая много фигур, и я хочу создать макрос, чтобы изменить ее, чтобы ограничивающий прямоугольник всех фигур (самый маленький, содержащий их все) имел общую границу заданного размера. Я могу найти размер ограничивающего прямоугольника и попытался использовать подпрограмму ActiveSelection.AlignAndDistribute для перемещения фигур, но у этой подпрограммы много параметров, которые я не понимаю (помощь мне не помогает).

Моя идея такова:

  1. Укажите границу, скажем, pgBorder.
  2. Получите ширину и высоту ограничивающего прямоугольника, скажем, shpsWidth и shpsHeight.
  3. Переместите фигуры так, чтобы нижний левый угол нового ограничивающего прямоугольника имел координаты (pgBorder, pgBorder).
  4. Сбросьте размер страницы до shpsWidth + 2 * pgBorder соответственно. shpHeight + 2 * pgBorder.

Прямоугольник, ограничивающий фигуру, теперь должен быть окружен рамкой размером pgBorder.

Это то, что у меня есть до сих пор:

Sub GivePageCommonBorder()
    Dim pgBorder As Double, shpsWidth As Double, shpsHeight As Double
    Dim doc As Document
    Dim pg As Page
 
    Set doc = ActiveDocument
    doc.Unit = cdrMillimeter
    pgBorder = 20
    Set pg = doc.ActivePage
    ' Select all shapes on the page
    pg.Shapes.All.CreateSelection
    shpsWidth = ActiveSelection.SizeWidth
    shpsHeight = ActiveSelection.SizeHeight
    
    ' This is what I am lacking:
    ' Move the selection so its lower left corner has coordinates (pgBorder,pgBorder)
    
    ' Adjust page size
    pg.SizeWidth = shpsWidth + 2 * pgBorder
    pg.SizeHeight = shpsHeight + 2 * pgBorder
End Sub

С наилучшими пожеланиями Хольгер


macros coreldraw
person Holger Nielsen    schedule 16.11.2020    source источник

Ответы (1)


arrow_upward
0
arrow_downward

Я только что наткнулся на метод .Move и построил следующее решение:

Sub GivePageCommonBorder()
    Dim pgBorder As Double
    Dim doc As Document
    Dim pg As Page
 
    Set doc = ActiveDocument
    doc.Unit = cdrMillimeter
    pgBorder = 5
    Set pg = doc.ActivePage
    pg.Shapes.All.CreateSelection
    With ActiveSelection
        pg.SizeWidth = .SizeWidth + 2 * pgBorder
        pg.SizeHeight = .SizeHeight + 2 * pgBorder
        .Move pgBorder - .LeftX, pgBorder - .BottomY
    End With
End Sub

Хольгер

person Holger Nielsen    schedule 16.11.2020