[CDR 2025] Дорисовать скомбинированный объект макросом

[Dinosaur]

Добрый день! Я немного знаком с макросами, писал но немного застопорился
В кратце что делает макрос: после получения координат пересечений строит кривые по ним, и комбинирует их в один объект (картинку прикрепил)
Теперь мне нужно соединить промежутки.
Я пробовал скопировать в массив координаты всех точек и построить новую кривую по ним, но тк направление сегментов и порядок subpath разный,
получается не правильное соединение.

Я вижу выход только высчитывать ближайшие точки, с что-то придумать чтоб их соединить

Но хотел узнать, может есть способ по легче?
Спасибо!

 

[_MBK_]

А чем вы планируете заполнять пространство между висячими нодами и по какому принципу будет соответствие проводится? В общем случае задача, конечно, нетривиальна, но хотелось бы посмотреть пример "было-стало", да и вообще непонятна окончательная задача полностью.

 

[zollinger]

А принципиально макрос? Окошко Join curves (Соединить кривые) не подойдет?

 

[zollinger]

В общем случае задача, конечно, нетривиальна,

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

 

[_MBK_]

А принципиально макрос? Окошко Join curves (Соединить кривые) не подойдет?
Посмотреть вложение 177026Посмотреть вложение 177027

направление сегментов и порядок subpath разный,

 

[zollinger]

Покажите, как должно получиться в приведенном вами примере

 

[_MBK_]

Покажите, как должно получиться в приведенном вами примере

Ты внимательно ТЗ прочитай. Предполагается, что произвольное количество разнонаправленных отрезков надо обьединить в необязательно односвязный шейп.

 

[zollinger]

Вот получено из примера ТС. Вверху его картинка, внизу воспроизведены векторные линии, справа - результат join curves

 

[zollinger]

обьединить в необязательно односвязный шейп.

вот тут хотелось бы поподробнее, желательно, с примером

 

[zollinger]

а вот так?

Sub JoinSelectedCurves()
    Dim s As Shape
    Dim sr As ShapeRange
    Dim tol As Double 'допуск для совмещения'
     
     Set doc = ActiveDocument
    If doc Is Nothing Then Exit Sub
   
    Dim originalUnit As cdrUnit
    originalUnit = doc.Unit
    doc.Unit = cdrMillimeter
    ' Устанавливаем допуск (расстояние, на котором узлы соединятся)
    tol = 0.5 ' Например, 0.5 мм (единицы зависят от настроек документа)
   
    Set sr = ActiveSelectionRange
   
    ' 1. Сначала нужно объединить отдельные объекты в один (Combine)
    If sr.Count > 1 Then
        Set s = sr.Combine
    Else
        Set s = sr(1)
    End If
   
    ' 2. Если объект — кривая, соединяем разомкнутые пути
    If s.Type = cdrCurveShape Then
        ' Метод ищет разомкнутые концы в пределах допуска и соединяет их
        s.Curve.JoinTouchingSubpaths True, tol
    End If
End Sub

Главное, допуск правильно выбрать (tol)
Точки просто стянутся друг к другу!