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

Код: 
Application.FrameWork.Automation.InvokeItem "ce73460f-ccd3-75a5-427a-0b5e757a642a"
'вызов/закрытие докера Join Curves
 
  • Спасибо
Реакции: Dinosaur
Не увидел последнего сообщения
 
Последнее редактирование:
dastin сказал(а):
Application.FrameWork.Automation.InvokeItem "ce73460f-ccd3-75a5-427a-0b5e757a642a"
Нажмите, чтобы раскрыть...
Да, докер открывается, спасибо

Еще пытался вот так сделать, но нет
sr(1).Curve.Nodes.ALL.Application.FrameWork.Automation.InvokeItem "259d7733-648b-4eb3-ae96-3768ea6370d3" 'chamfer

В общем наверное всё, всем спасибо!!! Эта тема с InvokeItem для меня новая, я к ней позже вернусь
 
Я просто плохо понимаю InvokeItem "".
Если можно было сделать то, что делает докер Join Curve(chamfer), только в цикле макроса . Ну то есть по очереди перебирать шейпы (состоящие из отрезков, скомбинированные) и соединять их (с запасом взять Gap+ -).
 
Dinosaur сказал(а):
Я просто плохо понимаю InvokeItem "".
Если можно было сделать то, что делает докер Join Curve(chamfer), только в цикле макроса . Ну то есть по очереди перебирать шейпы (состоящие из отрезков, скомбинированные) и соединять их (с запасом взять радиус+ -).
Нажмите, чтобы раскрыть...
InvokeItem нельзя давать аргументом обьекты. Но можно выделять обьекты перед его запуском.
 
  • Спасибо
Реакции: zollinger и Dinosaur
так есть же метод closespoinnt или как там его.
пробегаем по всем концам. ищем к каждому концу ближайшую точку. и дорисовываем линию appendlinesegment
ну или делаем combine объекту и jointochedsubpath с параметром разворота линий и он всё соединит
 
  • Спасибо
Реакции: Dinosaur
Код: 
    ActiveDocument.Unit = cdrMillimeter
    Dim s As Shape
    Dim s2 As New Shape
    
    Set s = ActiveSelection
    
    s2 = s.Curve.JoinTouchingSubpaths(True, 0.5)

Я пробовал JoinTouchingSubpaths, но шибка компиляции
 
Dinosaur сказал(а):
Я не знаю, как я упустил этот код или сейчас просто сейчас увеличил tol = 1000, но самое главное, это работает!!!!!!!
Спасибо вам большое! всем спасибо за помощь!
Обязательно разберусь в этом коде!
Нажмите, чтобы раскрыть...
вы же только учтите что там единицы документа стоят миллиметры.
если вы делаете tol = 1000 он будет искать в радиусе 1 метра.
 
DukereD сказал(а):
вы же только учтите что там единицы документа стоят миллиметры.
если вы делаете tol = 1000 он будет искать в радиусе 1 метра.
Нажмите, чтобы раскрыть...
Мы не знаем, какого размера у него кривые и что он вообще делает. Допуск в любом случае придется настраивать/подгонять
 
  • Спасибо
Реакции: DukereD
Добавил в ваш код проверку, чтобы не искал точки на своем же сегменте и tol оказался не нужен и вроде все отлично работает
Код:
Код: 
    ActiveDocument.Unit = cdrMillimeter

    Dim sr As ShapeRange
    Dim s As Shape
    Dim crv As Curve
    Dim sp As SubPath
    Dim nodes() As Node
    Dim used() As Boolean
    Dim nCount As Long
    Dim i As Long, j As Long
    Dim dx As Double, dy As Double, d As Double
    Dim bestD As Double, bestJ As Long
    Dim bridges As New ShapeRange
    Dim bridge As Shape
    Dim numSubPath_i As Long
    Dim numSubPath_j As Long


    Set sr = ActiveSelectionRange

    nCount = 0

    For Each sp In sr(1).Curve.SubPaths
      
            nCount = nCount + 2
            ReDim Preserve nodes(1 To nCount)
            ReDim Preserve used(1 To nCount)
            
            Set nodes(nCount - 1) = sp.StartNode
            Set nodes(nCount) = sp.EndNode
            
            used(nCount - 1) = False
            used(nCount) = False

    Next sp



    For i = 1 To nCount
    numSubPath_i = nodes(i).SubPath.Index
        If Not used(i) Then
            bestD = 1E+30
            bestJ = 0
            
            For j = 1 To nCount
            numSubPath_j = nodes(j).SubPath.Index
                If j <> i And Not used(j) And numSubPath_i <> numSubPath_j Then
                    dx = nodes(j).PositionX - nodes(i).PositionX
                    dy = nodes(j).PositionY - nodes(i).PositionY
                    d = Sqr(dx * dx + dy * dy)
                    
                    If d < bestD Then
                        bestD = d
                        bestJ = j
                    End If
                End If
            Next j
            
          
            If bestJ > 0 Then
                used(i) = True
                used(bestJ) = True
            
                Set bridge = ActiveLayer.CreateLineSegment( _
                    nodes(i).PositionX, nodes(i).PositionY, _
                    nodes(bestJ).PositionX, nodes(bestJ).PositionY)
                
                bridges.Add bridge
            End If
            
        End If
    Next i

    If bridges.Count > 0 Then
        bridges.Add sr(1)
        Set s = bridges.Combine
        s.Curve.JoinTouchingSubpaths True, 0.1
    End If

    Application.Refresh
 
ну и хорошо. tol, правда, не для этого, а чтобы не пыталось стыковать слишком далеко расположенные сегменты. Но, вероятно, для вашей задачи нужно именно так
 
Для ответа нужно войти/зарегистрироваться
Верх Низ
Назад