[CDR 2017-2021] Автоматизация порядка объектов в диспетчере

[Дмитрий2022]

Помогите допилить макрос
Sub Macro1()
Dim i As Long, t As Boolean
t = True
Do While t
t = False
For i = 1 To ActiveLayer.Shapes.Count - 1
S1 = Sqr((-100000 - ActiveLayer.Shapes.Item(i).CenterY) ^ 2 + (100000 - ActiveLayer.Shapes.Item(i).CenterX) ^ 2)
S2 = Sqr((-100000 - ActiveLayer.Shapes.Item(i + 1).CenterY) ^ 2 + (100000 - ActiveLayer.Shapes.Item(i + 1).CenterX) ^ 2)
If S1 < S2 Then
ActiveLayer.Shapes(i).OrderBackOf ActiveLayer.Shapes(i + 1)
t = True
End If
Next i
Loop
End Sub

 

[~RA~]

У вас сестры нет?

 

[Дмитрий2022]

сейчас он перемещает объекты в диспетчере исходя из расположения на рисунке от верхнего левого удаляясь по радиусу....
нужно чтобы обьекты в диспетчере располагались по порядку первый в ряду второй и так далее затем второй ряд.. и тд. согласно расположению на рисунке. например такой рисунок.

 

[Дмитрий2022]

У вас сестры нет?

эээммм????

 

[Jeine]

эээммм????

Да есть на этом форуме барышня одна... Вот она тоже пишет по-русски. И даже почти без ошибок. Но понять её, мягко говоря, сложно.

 

[_MBK_]

Да есть на этом форуме барышня одна... Вот она тоже пишет по-русски. И даже почти без ошибок. Но понять её, мягко говоря, сложно.

И макросами как раз в последнее время увлеклась. Совпадение?

Код у нас тут помещают в специальные тэги, обратите внимание на значки сверху окна ввода.
Иначе ваш код даже не дойдет до нас в полном обьеме

 

[lev]

Сортируем по верхнему левому углу

Sub PosSortOrder()
  ActiveDocument.BeginCommandGroup "sort by pos"
  Set sr = ActiveLayer.Shapes.All
  sr.Sort "@shape1.Top * 100 - @shape1.Left > @shape2.Top * 100 - @shape2.Left"
  For Each s In sr.Shapes
    s.OrderToBack
  Next s
  ActiveDocument.EndCommandGroup
End Sub

 

[Дмитрий2022]

простите что не так....

 

[Дмитрий2022]

Сортируем по верхнему левому углу

Sub PosSortOrder()
  ActiveDocument.BeginCommandGroup "sort by pos"
  Set sr = ActiveLayer.Shapes.All
  sr.Sort "@shape1.Top * 100 - @shape1.Left > @shape2.Top * 100 - @shape2.Left"
  For Each s In sr.Shapes
    s.OrderToBack
  Next s
  ActiveDocument.EndCommandGroup
End Sub

разброс еще больше стал))))

 

[Дмитрий2022]

блин.... может нужно искать ближайшую точку начала следующего вектора?) это вообще возможно?

 

[Дмитрий2022]

порядок нужен для минимального перемещения инструмента. по вектору происходит резка материала....

 

[lev]

Для минимального перемещения у вас было в исходном коде - искались расстояния между объектами. Но в описании вы захотели расставить как буквы в книжке.

по порядку первый в ряду второй и так далее затем второй ряд.. и тд.

т.е. будет происходить возврат c конца строки к началу второй, что не способствует минимизации хода головки.

 

[Gad]

Не по теме:

@DukereD Corel Draw: Панель макросов для лазерной резки и не только.
Я даже не пытался разобраться в том безумии что он наворотил, но может найдете для себя полезное

 

[Дмитрий2022]

Для минимального перемещения у вас было в исходном коде - искались расстояния между объектами. Но в описании вы захотели расставить как буквы в книжке.

т.е. будет происходить возврат c конца строки к началу второй, что не способствует минимизации хода головки.

да вы сделали именно так как я описал.... но так еще чем в моем варианте(

 

[Дмитрий2022]

Sub Macro1()
    Dim i As Long, t As Boolean
    t = True
    Do While t
        t = False
        For i = 1 To ActiveLayer.Shapes.Count - 1
            S1 = Sqr((-100000 - ActiveLayer.Shapes.Item(i).CenterY) ^ 2 + (100000 - ActiveLayer.Shapes.Item(i).CenterX) ^ 2)
            S2 = Sqr((-100000 - ActiveLayer.Shapes.Item(i + 1).CenterY) ^ 2 + (100000 - ActiveLayer.Shapes.Item(i + 1).CenterX) ^ 2)
            If S1 < S2 Then
                ActiveLayer.Shapes(i).OrderBackOf ActiveLayer.Shapes(i + 1)
                t = True
            End If
        Next i
    Loop
End Sub

 

[DukereD]

но так еще чем в моем варианте(

)))) видимо родственник таки ))))

ваша цель выстроить элементы змейкой похоже

 

[splxgf]

порядок нужен для минимального перемещения инструмента. по вектору происходит резка материала....

Это немного другая задача, тут много где можно заморочиться.
Еще бы знать какая точка выбирается у каждой фигуры для начала рисования, затем собираются все расстояния между этими точками и дальше стандартная задача коммивояжера с эвристиками.

 

[DukereD]

Это немного другая задача, тут много где можно заморочиться.
Еще бы знать какая точка выбирается у каждой фигуры для начала рисования, затем собираются все расстояния между этими точками и дальше стандартная задача коммивояжера с эвристиками.

я думаю что тут больше хотят избавиться от лишних пустых перемещений и не требуется прям идеального кратчайшего пути. главное чтобы впустую шло до ближайшего объекта. хотя это все должна уметь управляющая программа станком. или очень странный станок такой который режет прям из корела )))

 

[splxgf]

я думаю что тут больше хотят избавиться от лишних пустых перемещений

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

 

[DukereD]

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

по радиусу оно искало просто ближайшие объекты.. его не устраивал это алгоритм вот и пришел сюда человек найти волшебную кнопку "сделать быстро" простым алгоритмом в 5 строчек. )))))))