[CDR 2017-2021] переместить созданную размерную линию на определенный слой

Captive

Участник
Топикстартер
Сообщения
40
Реакции
0
Добрый день.
Помогите в написании макроса. Заранее благодарен.
На данном форуме нашел макрос по расстановки размеров.
Но есть задача переместить созданную размерную линию на определенный слой.
Для этого встает необходимость в разгруппировки созданной размерной линии для последующего переноса на необходимый слой.
Разгруппировку вроде выполнил но по итогу переношу на слой только текс а сама размерная линия остается на исходном слое.
Помогите пожалуйста выполнить корректно данные действия...



Sub dim_each()
ActiveDocument.BeginCommandGroup "Dimensioner"
ActiveDocument.Unit = cdrMillimeter

Проверка наличия слоев и создание
If ActivePage.Layers.Find("слой2") Is Nothing Then ActivePage.CreateLayer ("слой2")

d = 15
For Each s In ActiveSelection.Shapes
ActiveLayer.CreateLinearDimension(cdrDimensionVertical, s.SnapPoints.BBox(cdrTopMiddle), s.SnapPoints.BBox(cdrBottomMiddle), TextSize:=72).Dimension.TextShape.PositionX = s.LeftX + d
ActiveSelection.Separate
ActiveSelection.MoveToLayer ActivePage.Layers("слой2")

ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, s.SnapPoints.BBox(cdrMiddleLeft), s.SnapPoints.BBox(cdrMiddleRight), TextSize:=72).Dimension.TextShape.PositionY = s.TopY - d
ActiveSelection.Separate
ActiveSelection.MoveToLayer ActivePage.Layers("слой2")

Next s
ActiveDocument.EndCommandGroup
End Sub
 

izrukvruki

15 лет на форуме
Сообщения
1 833
Реакции
302
а сразу создавать размерные линии на нужном слое не проще ли, чем рисовать на активном и потом переносить на нужный слой?
Код:
ActiveDocument.Unit = cdrMillimeter
d = 15
Dim s As Shape
Set s = ActiveShape
ActivePage.Layers("2").CreateLinearDimension(cdrDimensionHorizontal, s.SnapPoints.BBox(cdrMiddleLeft), s.SnapPoints.BBox(cdrMiddleRight), TextSize:=72).Dimension.TextShape.PositionY = s.TopY - d
 
  • Спасибо
Реакции: Captive

Captive

Участник
Топикстартер
Сообщения
40
Реакции
0
Не совсем могу разобраться в присланном Вами коде.
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
  • Спасибо
Реакции: Captive

Captive

Участник
Топикстартер
Сообщения
40
Реакции
0
Тут как то совсем получается не особо то что мне нужно.
когда проставляешь размерную линию она автоматом объединяется с основным вектором.
А мне нужно чтобы они были отдельно друг от друга и располагались на разных слоях.
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835

Captive

Участник
Топикстартер
Сообщения
40
Реакции
0
Я в меру кривых рук написал так))По факту когда разгруппировываю размерную линию она имеет несколько составных частей
1)это текс с размером
2)это линии со стрелками
А как это все вместе выбрать после разгруппировки - я не как не пойму(
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
Если мне не изменяет склероз, то эти две команды заменить на

ActiveSelection.SeparateEx.MoveToLayer.ActivePage.Layers("слой2")
 

Captive

Участник
Топикстартер
Сообщения
40
Реакции
0
Встает в ошибку....
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835

Captive

Участник
Топикстартер
Сообщения
40
Реакции
0
Мммм...
В общем все работает при вот таком условии.


Sub dim_each()
ActiveDocument.BeginCommandGroup "Dimensioner"
ActiveDocument.Unit = cdrMillimeter


If ActivePage.Layers.Find("sloi") Is Nothing Then ActivePage.CreateLayer ("sloi")

d = 15
For Each s In ActiveSelection.Shapes
ActiveLayer.CreateLinearDimension(cdrDimensionVertical, s.SnapPoints.BBox(cdrTopMiddle), s.SnapPoints.BBox(cdrBottomMiddle), TextSize:=100).Dimension.TextShape.PositionX = s.LeftX + d
ActiveSelection.Separate
ActiveSelection.MoveToLayer ActivePage.Layers("sloi")

ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, s.SnapPoints.BBox(cdrMiddleLeft), s.SnapPoints.BBox(cdrMiddleRight), TextSize:=100).Dimension.TextShape.PositionY = s.TopY - d
ActiveSelection.Separate
ActiveSelection.MoveToLayer ActivePage.Layers("sloi")

Next s
ActiveDocument.EndCommandGroup
End Sub


А возможно ли произвести удаление определенных векторов в определенном слое?
Примерно вот это(Во вложении)
 

Вложения

  • Безымянный.png
    Безымянный.png
    15.3 КБ · Просм.: 117
Последнее редактирование модератором:

izrukvruki

15 лет на форуме
Сообщения
1 833
Реакции
302
А возможно ли произвести удаление определенных векторов в определенном слое?
Вы создаете линии, потом отделяете, группируете, теперь присвойте имя этой группе, например name_1, для следующей линии name_2 и тд. (наверное надо какую-то проверку делать, чтоб выяснить какой номер будет у очередной группы, перебирать все шейпы с именем name_), а потом можете удалять любую группу по ее имени.