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

Статус
Закрыто для дальнейших ответов.

krassergey

Участник
Топикстартер
Сообщения
14
Реакции
0
Столкнулся с необходимостью резать линии на сегменты (subpath), чтобы можно было задать длину сегментов. Для CorelDraw X5 когда-то нашел в интернете макрос CurveCut, но на следующих версиях Corela он не работает. Может быть есть этому макросу замена или теперь задача решается каким-то стандартным инструментом Corela?
Спасибо!
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
Навряд ли есть. Но макрос совсем простецкий, наверное имеет смысл выложить на препарирование и адаптацию к актуальным версиям.
 

krassergey

Участник
Топикстартер
Сообщения
14
Реакции
0
Тот который был у меня - с закрытым кодом.
Если у Вас есть исходник, который можно пробовать переделать, был бы очень признателен :)
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
Это меняет дело. Хоть код закрывается чисто символически от честных людей, но мы все здесь джентельмены и ценим чужое приваси на собственный код. Тем более, макрос, наверное, еще и платный?
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
нашел в интернете макрос CurveCut
А впрочем, (если это, конечно, не варез) то киньте ссылку сюда или сам макрос в обменник
А то я такого макроса сходу нагуглить не могу 'hmmm'
 

krassergey

Участник
Топикстартер
Сообщения
14
Реакции
0
Макрос был бесплатный, но закрытый. Раздавался 5 лет назад.
Возможно автор продавал, что-то более навороченное, а этот код закрыл из принципа.
Сейчас никаких следов в интернете - я первым делом поискал именно его: вдруг, автор обновил для новых версий Corela.
Можно предположить, что автор макроса нашел какое-то более доходное занятие и не обидится, если мы посмотрим его код.
Я бы посмотрел (если бы знал как :) )
это ссылка на здешний файлообменник:
макрос CurveCut2
 

lev

Модератор
20 лет на форуме
Сообщения
2 142
Реакции
2 066
Не надо предполагать. Перечитайте правила.
Проще взять код отсюда [X7] - пунктирная кривая из нескольких абрисов???
и убрать последний блок For i ... Next

Не по теме:
PS на просторах Интернета находится несколько Curve Divider/Splitter'ов, правда, в основном режущих не на куски заданных размеров, а на заданное кол-во равных кусков. А с версии X7 появилась функция EqualDivide делающая то же самое.
 
Последнее редактирование:

krassergey

Участник
Топикстартер
Сообщения
14
Реакции
0
Перечитайте правила.
Видимо имеется в виду 5.1 ?
Взлом платных программ не подразумевался. Макрос был бесплатным под X5, сейчас его вообще не найти.

Проще взять код отсюда...
Спасибо. Попробую разобраться. 'thank'
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
А! Точно, я и забыл, что они формат GMS поменяли в поздних версиях
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835

Fog_patch

12 лет на форуме
Сообщения
3 163
Реакции
998
Можно и ручками, если вдруг макроса нет или он не запускается.
Создаём бленд из линий, пускаем по кривой
Включаем докер бленд, настраиваем blend spacing
Берём нож, отключаем keep one и auto close
Тыкаем в местах пересечения кривой и бленд-полосок.
Кривая должна быть наверху.
upload_2017-3-18_22-40-33.png
 
  • Спасибо
Реакции: lev

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
В двух словах - в этой строке Long замените на LongLong
 

krassergey

Участник
Топикстартер
Сообщения
14
Реакции
0
Можно и ручками
да, можно - хороший способ :)

но вопрос решился.
Проще взять код отсюда

немного измененный код от 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

Изящности может и не хватает, но работает.
 

Fog_patch

12 лет на форуме
Сообщения
3 163
Реакции
998
В двух словах - в этой строке Long замените на LongLong
Всё равно ругается. Лень разбираться, но я просто закомментил всю строку и макрос заработал. Но он откусывает всего один сегмент.
 
Статус
Закрыто для дальнейших ответов.