1. Пользоваться форумом на планшетах и телефонах стало удобнее благодаря Tapatalk

Аппроксимация кривых Безье

Тема в разделе "CorelDraw", создана пользователем -, 15 апр 2003.

Модераторы: Артер
  1. Guest

    Народ, такая вот проблема.

    Я рисую различные векторные траектории Corelом для последующей обработки на ЧПУ. Программа для ЧПУ принимает формат dxf версии 10. Но ведь Corel экспортирует в dxf совершенно неприемлимым образом - каждая кривая бьется на 16, 32 а то и 64 прямых отрезка полилинии.
    Я думаю не стоит распинаться, что насиловать ЧПУ, объясняя ему что передвичаться следует 1000 раз по 0,1 мм.
    Короче, нужен способ аппроксимации полученной полилинии последовательностью дуг и прямых. Кто с этим сталкивался - помогите!!!
     
  2. Guest

    Используй метод половинного деления — по критерию квадратичной ошибки.
    Код ниже (для CDR-11, для CDR-10 другой порядок параметров GetPointPositionAt ):
    Private Sub plotCurveSegment(segCurve As Segment, ByVal dblSquareThreshold As Double)
    ' Первая точка НЕ СТАВИТСЯ!!!!
    Dim dblAngle As Double, _
    dblFirstPeak As Double, _
    dblSecondPeak As Double, _
    intPeaks As Integer
    ' Поиск пиков (наибольшей кривизны на кривой
    If 1 = segCurve.GetPeaks((segCurve.GetPerpendicularAt(0, cdrParamSegmentOffset) _
    + segCurve.GetPerpendicularAt(1, cdrParamSegmentOffset)) / 2, _
    dblFirstPeak, dblSecondPeak, cdrRelativeSegmentOffset) _
    Then
    ' Сегмент имеет один пик и не имеет перегибов
    Call ApproxInternalSegment(segCurve, 0, dblFirstPeak, dblSquareThreshold)
    Call ApproxInternalSegment(segCurve, dblFirstPeak, 1, dblSquareThreshold)
    Else
    ' Сегмент имеет два пика: через пики и точку перегиба
    Call ApproxInternalSegment(segCurve, 0, dblFirstPeak, dblSquareThreshold)
    Call ApproxInternalSegment(segCurve, dblFirstPeak, (dblSecondPeak + dblFirstPeak) / 2, dblSquareThreshold)
    Call ApproxInternalSegment(segCurve, (dblSecondPeak + dblFirstPeak) / 2, dblSecondPeak, dblSquareThreshold)
    Call ApproxInternalSegment(segCurve, dblSecondPeak, 1, dblSquareThreshold)
    End If
    End Sub

    ' Апроксимируем внутреннюю часть сегмента между t1 и t2.
    '
    Private Sub ApproxInternalSegment(s As Segment, ByVal t1 As Double, ByVal t2 As Double, ByVal dblSquareThreshold As Double)
    Dim intIterationCounter As Integer
    Dim x0 As Double, y0 As Double
    intIterationCounter = 0 ' Счетчик числа итераций поиска точки
    s.GetPointPositionAt x0, y0, t1, cdrRelativeSegmentOffset
    t1 = FindPoint(s, x0, y0, t1, t2, intIterationCounter, dblSquareThreshold)
    If intIterationCounter > 1 Then
    ' Была добавлена промежуточная точка
    ' Продолжим между промежуточной точкой и конечной точкой t2
    Call ApproxInternalSegment(s, t1, t2, dblSquareThreshold)
    Else
    ' исходная точка сразу удовлетворяла условиям

    End If
    End Sub

    Private Function FindPoint(ByRef s As Segment, x0 As Double, y0 As Double, ByVal t1 As Double, _
    ByVal t2 As Double, ByRef intCounter As Integer, ByVal dblSquareThreshold As Double) As Double

    Dim x1 As Double, y1 As Double ' Конец хорды
    Dim xm As Double, ym As Double ' Середина хорды
    Dim smx As Double, smy As Double ' Середина сегмента
    Dim halfT As Double
    Dim dblErr As Double ' Квадрат расстояния между серединой хорды и серединой сегмента
    Dim a As Double, b As Double, c As Double
    intCounter = intCounter + 1
    s.GetPointPositionAt x1, y1, t2, cdrRelativeSegmentOffset
    xm = (x1 + x0) / 2: ym = (y1 + y0) / 2: halfT = (t2 + t1) / 2
    s.GetPointPositionAt smx, smy, halfT, cdrRelativeSegmentOffset
    dblErr = (smx - xm) ^ 2 + (smy - ym) ^ 2
    If dblErr < dblSquareThreshold Then
    ' Точка x1,y1 удовлетворяет необходимым требованиям - добавляем ее в список
    ' И следующий этап начнем со следующего параметра t
    Call sendPDCommand(x1, y1)
    FindPoint = t2
    Else
    ' Берем половину
    FindPoint = FindPoint(s, x0, y0, t1, halfT, intCounter, dblSquareThreshold)
    End If
    End Function
     
  3. Guest

    То есть я экспортирую кривые из Corelа например в dxf, а затем этот самый dxf обрабатываю этим макросом?
     
  4. Guest

    Arkady'й !
    Большое Спасибо за VBA!
    Почти закончил.
    Давненько не трогал API.Еще больше не брал в руки VBA.Развращает VCL.
    Немножко подправил, кстати, и тот код, что ты здесь приводишь.
    ЧуЧь-ЧуЧь измений.
    Получилась симпатичная фигня, не отличишь от родного *.flt.
    Жди письма.
    Кстати, как мой plt-view'ер?
     
  5. Guest

    Во! Гении! Вот это уважаю:)
     
  6. Guest

    Народ!!!!!!!!!!!!
    На фига так замарачиваться!!!
    Есть способ на много быстрее и удобней, точнее есть програмка Flexi.
    В ней просто пересохраняешь вфайл в dxf и готово.
    Народ а кто-гить знает как почситать длину сразу нескольких полилиний в Corele
     
Модераторы: Артер

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