Используй метод половинного деления — по критерию квадратичной ошибки.
Код ниже (для 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
