[CDR 2017-2021] Ищу макрос — расстояние между объектом и краями страницы

Пятниццца

Топикстартер
10 лет на форуме
Сообщения
15
Реакции
0
Добрый день!

Подскажите, нет ли решения для такой задачи:
Есть объект(ы) на странице, хочется выделить их запустить макрос, и от выделенного объекта(группы объектов) нарисуются актуальные размеры с четырех сторон до краев страницы (от низа, слева, справа и от верха).

Есть ли что-то подобное? Буду признателен за любой совет, как это сделать.
 

lev

Модератор
20 лет на форуме
Сообщения
2 146
Реакции
2 071
Код:
Sub page_dist_size()

  ActiveDocument.BeginCommandGroup "Page Dist & Size Dimensions"
  If ActiveSelection.Shapes.Count = 0 Then Exit Sub
  ActiveDocument.Unit = cdrMillimeter
  dist = 12
  txt_size = 24

  Dim p As Page
  Set p = ActivePage
  Set s = ActiveSelection.Shapes.All


  Set pt = ActiveDocument.CreateFreeSnapPoint(p.CenterX, p.TopY)
  Set pb = ActiveDocument.CreateFreeSnapPoint(p.CenterX, p.BottomY)
  Set pl = ActiveDocument.CreateFreeSnapPoint(p.LeftX, p.CenterY)
  Set pr = ActiveDocument.CreateFreeSnapPoint(p.RightX, p.CenterY)

  Set st = ActiveDocument.CreateFreeSnapPoint(s.CenterX, s.TopY)
  Set sb = ActiveDocument.CreateFreeSnapPoint(s.CenterX, s.BottomY)
  Set sl = ActiveDocument.CreateFreeSnapPoint(s.LeftX, s.CenterY)
  Set sr = ActiveDocument.CreateFreeSnapPoint(s.RightX, s.CenterY)

  'расстояния от границ страницы
  ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pt, st, TextSize:=txt_size).Dimension.TextShape.PositionX = s.LeftX - dist
  ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pb, sb, TextSize:=txt_size).Dimension.TextShape.PositionX = s.LeftX - dist
  ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pl, sl, TextSize:=txt_size).Dimension.TextShape.PositionY = s.TopY + dist
  ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pr, sr, TextSize:=txt_size).Dimension.TextShape.PositionY = s.TopY + dist

  'размеры выделения
  ActiveLayer.CreateLinearDimension(cdrDimensionVertical, st, sb, TextSize:=txt_size).Dimension.TextShape.PositionX = s.LeftX - dist
  ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, sr, sl, TextSize:=txt_size).Dimension.TextShape.PositionY = s.TopY + dist

  ActiveDocument.EndCommandGroup
End Sub