[CDR 2017-2022] Несколько групп рядом

[Григор-313]

Тут исправлена ошибка при вводе дробных чисел (можно ставить и точку, и запятую), и пример понагляднее.
Точнее описать так: "Указываем, на каком минимальном удалении находятся разные группы" (то есть ширину пробела между числами или словами и межстрочный интервал). Всё что ближе между собой - группируется

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

 

[zollinger]

логично было выложить образец файла. Ну, видимо не судьба

 

[zollinger]

А вот так он вряд не сможет, только на ровной сетке. Моему всё равно

 

[zollinger]

Каждый отдельный объект в красной рамке. слева исходные объекты, справа - результат работы

 

[Григор-313]

Каждый отдельный объект в красной рамке. слева исходные объекты, справа - результат работы
Посмотреть вложение 176598

Я же не говорю что он не работает.
Я не смог его запустить.

 

[lev]

внёс для себя небольшие правки, см. тестовый файлик:

      'не учитываем диагональные совпадения
      If (gapX <= maxGapX And gapY = 0) Or (gapY <= maxGapY And gapX = 0) Then
        Union parent, i, j
      End If

и чуток упростил проверку ввода (функциям IsNumeric и CDbl без разницы вид десятичного знака, наличие буковок в поле ввода и т.п., например "a1b1c1" даст результат 0, а не 111, как в текущей реализации, лично мне, так кажется даже лучше):

Function ParseDouble(s As String) As Double
  If IsNumeric(s) Then ParseDouble = CDbl(s) Else ParseDouble = 0
End Function

 

[zollinger]

ей реализации, лично мне, так кажется даже лучше):

Function ParseDouble(s As String) As Double
  If IsNumeric(s) Then ParseDouble = CDbl(s) Else ParseDouble = 0
End Function

Я тоже так думал. Но оказалось, что из-за русской локали это работает совсем не так, как предполагается. Да это просто - введи 0,8 (или 0,5, или все равно как) и окажется, что он возвращает 0. Просто после преобразования воткни MessageBox и посмотри

 

[lev]

у меня работает

Sub test_pd()
  Debug.Print ParseDouble("0,8")
  Debug.Print ParseDouble(",834")
  Debug.Print ParseDouble("   -   0   ,   8   ")
  Debug.Print ParseDouble("  .8   ")
  Debug.Print ParseDouble("   .   8   ")  'не фурычит, да и ладно
  Debug.Print ParseDouble("1a2a3f")
End Sub

 

[zollinger]

А версия корела какая?

 

[zollinger]

Я почему-то в это вот уперся, сам удивился. Может, чего-то косячу. Но это пофиг, в общем, это дело десятое.
Но проверь, пожалуйста, именно в реальном вводе. Ну вот на всякий случай. У меня дома корела нет, а интересно

 

[lev]

Тестировал перед выкладыванием, просто в сообщении пример тестов приводить не стал.
CorelDRAW X7, Win7 32 bit рус, системный десятичный разделитель "."
Можно не заморачиваться, всё равно для реальной работы стоит формочку наколхозить (ради доп. функционала), ну и ограничить ввод в соответствующие поля.

 

[zollinger]

Странно, почему у меня в 2020 не заработало, где-то на пустом месте натупил, похоже, завтра проверю.
Изначально было так

maxGapX = CDbl(Replace(gx, ",", "."))
maxGapY = CDbl(Replace(gy, ",", "."))

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

 

[lev]

Да а зачем она нужна для реальной работы?

Чуть выше приложил тестовый файл - раздробленная календарная сетка, которую захотелось объединить по месяцам и повыравнивать. Могу и сам сетку разгруппировать для быстрой покраски выходных, а обратно группировать чуток неудобно. Заодно на файлике тестируется предложение по диагоналям.

 

[zollinger]

Всё, понял, что у меня там было. Перепутал порядок параметров. Я запятую на точку менял, а нужно было точку на запятую.

maxGapX = CDbl(Replace(gx, ".", ","))
maxGapY = CDbl(Replace(gy, ".", ","))

Не удержался, поставил корел дома. Проверил, работает.
И да, с вот этим

 'не учитываем диагональные совпадения
      If (gapX <= maxGapX And gapY = 0) Or (gapY <= maxGapY And gapX = 0) Then
        Union parent, i, j
      End If

он собирает только по горизонтали или только по вертикали, и да, для твоего примера, календаря, действительно лучше, в исходном варианте он делает либо 6, либо 9 блоков, либо не присоединяет 1-2 к пятому месяце, либо объединяет последние три месяца. Будет ли это лучше для других кейсов - не факт (снежинки какие-нибудь). Но с календарем у тебя прям рабочий кейс

 

[lev]

в твоём примере с рамками все линии из двух точек. можно исключить их из обработки:
Set sr = ActiveSelectionRange.Shapes.FindShapes(Query:="@com.curve.nodes.count > 2")
а перед выходом сгруппировать сами рамки
ActiveSelectionRange.Shapes.FindShapes(Query:="@com.curve.nodes.count = 2").Group
Мне чаще попадаются рамки из прямоугольников в кривых, т.е. у меня такое не заработает, но, может, кому-то и пригодится.

Будет ли это лучше для других кейсов - не факт

а вот тута уже формочку можно городить с галочкой выбора

 

[zollinger]

а вот тута уже формочку можно городить с галочкой выбора

да, уже подумал. Жаль, в vba нельзя функцию как параметр передать, как в питоне или js так красиво можно было бы реализовать

в твоём примере с рамками все линии из двух точек. можно исключить их из обработки:

Это просто побочка, проявилось ну и ладно - курьез. Я тоже таблицы-чертежи в кореле не обрабатываю, просто нужен был пример с большим количеством мелких элементов.
Обрати внимание, они группируются в отдельные рамки, а не все в одну. То есть несколько аккуратнее чем то, что предлагаешь ты. Там основная рамка с основной надписью и две таблицы получаются. Если брать объекты с двумя точками, будет не то, один объект, а это противоречит исходной задаче

 

[lev]

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

 

[zollinger]

но, да, это очень частный случай

Именно, это чистая побочка, исходная задача этого не предусматривала

 

[Григор-313]

Смотрю тема интересной оказалась