[X6] Разделить произвольную кривую на сегменты заданной длины

Тема в разделе «CorelDRAW», создана пользователем krassergey, 15 мар 2017.

  1. Столкнулся с необходимостью резать линии на сегменты (subpath), чтобы можно было задать длину сегментов. Для CorelDraw X5 когда-то нашел в интернете макрос CurveCut, но на следующих версиях Corela он не работает. Может быть есть этому макросу замена или теперь задача решается каким-то стандартным инструментом Corela?
    Спасибо!
     
  2. Навряд ли есть. Но макрос совсем простецкий, наверное имеет смысл выложить на препарирование и адаптацию к актуальным версиям.
     
  3. Тот который был у меня - с закрытым кодом.
    Если у Вас есть исходник, который можно пробовать переделать, был бы очень признателен :)
     
  4. Это меняет дело. Хоть код закрывается чисто символически от честных людей, но мы все здесь джентельмены и ценим чужое приваси на собственный код. Тем более, макрос, наверное, еще и платный?
     
  5. А впрочем, (если это, конечно, не варез) то киньте ссылку сюда или сам макрос в обменник
    А то я такого макроса сходу нагуглить не могу 'hmmm'
     
  6. Макрос был бесплатный, но закрытый. Раздавался 5 лет назад.
    Возможно автор продавал, что-то более навороченное, а этот код закрыл из принципа.
    Сейчас никаких следов в интернете - я первым делом поискал именно его: вдруг, автор обновил для новых версий Corela.
    Можно предположить, что автор макроса нашел какое-то более доходное занятие и не обидится, если мы посмотрим его код.
    Я бы посмотрел (если бы знал как :) )
    это ссылка на здешний файлообменник:
    макрос CurveCut2
     
  7. Не надо предполагать. Перечитайте правила.
    Проще взять код отсюда [X7] - пунктирная кривая из нескольких абрисов???
    и убрать последний блок For i ... Next

    Не по теме:
    PS на просторах Интернета находится несколько Curve Divider/Splitter'ов, правда, в основном режущих не на куски заданных размеров, а на заданное кол-во равных кусков. А с версии X7 появилась функция EqualDivide делающая то же самое.
     
    #7 lev, 16 мар 2017
    Последнее редактирование: 16 мар 2017
  8. Видимо имеется в виду 5.1 ?
    Взлом платных программ не подразумевался. Макрос был бесплатным под X5, сейчас его вообще не найти.

    Спасибо. Попробую разобраться. 'thank'
     
  9. А на что он ругается в X7?
     
  10. после запуска выдает:
    Error.png
     
  11. А! Точно, я и забыл, что они формат GMS поменяли в поздних версиях
     
  12. Забыл...
    у меня X6
     
  13. В шапке темы написано
     
  14. Попробуйте вот этот вариант
    Лично у меня в X6 работает
     
  15. Можно и ручками, если вдруг макроса нет или он не запускается.
    Создаём бленд из линий, пускаем по кривой
    Включаем докер бленд, настраиваем blend spacing
    Берём нож, отключаем keep one и auto close
    Тыкаем в местах пересечения кривой и бленд-полосок.
    Кривая должна быть наверху.
    upload_2017-3-18_22-40-33.png
     
    • Одобряю Одобряю x 1
  16. ругается - у меня система 64-разрядная
    Error-1.jpg
     
  17. В двух словах - в этой строке Long замените на LongLong
     
  18. да, можно - хороший способ :)

    но вопрос решился.
    немного измененный код от LEV:

    Sub Curve_divider2()
    Dim sp As SubPath
    d = Val(InputBox("Введите размер сегмента в mm:", , 5))
    Optimization = True
    ActiveDocument.Unit = cdrMillimeter
    ActiveDocument.BeginCommandGroup "Divider"
    On Error GoTo ErrHandler

    For Each sp In ActiveShape.Curve.SubPaths
    For i = sp.Length - d To 0 Step -d
    If i > 0 Then
    sp.BreakApartAt i, cdrAbsoluteSegmentOffset
    End If
    Next i
    Next sp
    MsgBox "число сегментов: " & ActiveShape.Curve.SubPaths.Count

    ExitSub:
    ActiveDocument.EndCommandGroup
    Optimization = False
    ActiveWindow.Refresh
    Refresh
    Exit Sub
    ErrHandler:
    MsgBox "Error occured: " & Err.Description
    Resume ExitSub
    End Sub

    Изящности может и не хватает, но работает.
     
  19. Всё равно ругается. Лень разбираться, но я просто закомментил всю строку и макрос заработал. Но он откусывает всего один сегмент.
     

Поделиться этой страницей