贝塞尔曲线及插值Word文件下载.docx
《贝塞尔曲线及插值Word文件下载.docx》由会员分享，可在线阅读，更多相关《贝塞尔曲线及插值Word文件下载.docx（10页珍藏版）》请在冰豆网上搜索。
且第二个控制点与第一控制点距离取1/3*|Dot1_Dot3|,而不是1/6*|Dot1_Dot3|
假如1/2*|Dot2_Dot3|<
1/6*|Dot1_Dot3|
那么第二个控制点与第一控制点距离取1/2*|Dot2_Dot3|,而不是1/6*|Dot1_Dot3|
第三个控制点的位置是:
过第四个控制点（Dot3,终点），与Dot2,Dot4的连线平行，且与Dot3距离为1/6*|Dot2_Dot4|
假如是图形的最后一段曲线，取节点Last-2,Last-1,Last,Last进行计算,即Dot4=Dot3
且第三个控制点与第四控制点距离取1/3*|Dot2_Dot4|,而不是1/6*|Dot2_Dot4|
1/6*|Dot2_Dot4|
那么第二个控制点与第一控制点距离取1/2*|Dot2_Dot4|,而不是1/6*|Dot2_Dot4|
...............................................................................................
这个自定义函数的计算流程是
Step1:
检查输入的X-Y数值是否有错误，如（输入不够三个点，X-Y的数量不一致,起始搜索节点超过范围等等）
Step2:
从参数指定的节点开始，计算出四个贝塞尔控制点，得到贝塞尔插值多项式方程，
然后代入已知的待求数值，看它能不能满足f（t）=0有解（即曲线包含待查数值）
Step3:
如果f（t）=0有解，根据解出来的t值计算X-Y坐标，退出程序,否则继续检查下一段曲线
Step4:
如果所有分段曲线都不包含待查数值，退出程序
OptionExplicit
OptionBase1
'
所有数组的第一个元素编号为1（默认为0）
TypeVector
自定义数据结构（用二维向量代表坐标系里面的点坐标）
xAsDouble
yAsDouble
EndType
ConstNoError="
Noerror"
错误提示信息
ConstError1="
Error:
Thesizeofknown_xmustequaltosizeofknown_y"
ConstError2="
Thesizeofknown_xmustequaltoorgreaterthan3"
ConstError3="
StartKnotmustbe>
=1and<
=count（known_x）-1"
ConstError4="
known_value_typemustbe"
"
x"
"
y"
or"
t"
"
ConstError5="
Whenknown_value_typeis"
known_valuemust>
=0and<
=1"
ConstError10="
known_valueisnotonthecurve（definedbygivenknown_xandknown_y）"
ConstNoRoot="
NoRoot"
ConstMaxErr=0.00000001
ConstMaxLoop=1000
DimSizeX,SizeYAsLong
输入区域的大小
DimDot1AsVector
输入区域里面，用作计算贝塞尔控制点的四个节点
DimDot2AsVector
DimDot3AsVector
DimDot4AsVector
DimBezierPt1AsVector
生成贝塞尔曲线的四个贝塞尔控制点
DimBezierPt2AsVector
DimBezierPt3AsVector
DimBezierPt4AsVector
DimOffsetTo2AsVector
第二,三个贝塞尔控制点跟起点，终点的距离关系
DimOffsetTo3AsVector
DimValueTypeAsVariant
输入待查数值的类型,"
代表输入的是X坐标，求对应的Y坐标
DimInterpol_hereAsBoolean
当前分段曲线是否包含待查数值
Dimkey_value,a,b,c,dAsDouble
贝塞尔曲线插值多项式的系数
Dimt1,t2,t3AsVariant
贝塞尔曲线插值多项式的根
Dima3,a2,a1,a0AsDouble
Dimsize%
PublicSubbefit（ByRefknown_x（）AsDouble,ByRefknown_y（）AsDouble,sizeAsInteger,known_valueAsDouble,result（）AsVariant,OptionalStartKnotAsLong=1,Optionalknown_value_typeAsVariant="
）
--------------------------------------子过程方便VB中调用-----------------------------------------------------------
主程序开始，至少要输入五个参数，第一个是X坐标系列，然后是Y坐标系列，第三个是坐标点数，第四个是待查数值，第五个是返回值
第六个参数是从哪一段曲线开始查找，如果曲线可以返回多个值，那么分别指定起始节点就可以找出全部合要求的点
第七个参数是待查数值的类型,"
代表输入x坐标求对应y坐标，"
则相反,"
是直接输入贝塞尔插值多项式的参数
-------------------------------------------------------------------------------------------------
DimjAsLong
Dimx1Value,y1Value,x2Value,y2Value,x3Value,y3ValueAsVariant
DimErrorMsgAsVariant
ValueType=LCase（known_value_type）
待查数值的类型转化为小写，并赋值到全局变量ValueType
key_value=known_value
待查数值赋值到全局变量key_value
ErrorMsg=ErrorCheck（known_x,known_y,StartKnot）'
检查输入错误
IfErrorMsg<
>
NoErrorThen
有错误就返回错误信息，退出程序
result=Array（ErrorMsg,ErrorMsg,ErrorMsg,ErrorMsg,ErrorMsg,ErrorMsg）
ExitSub
EndIf
SizeX=UBound（known_x）
Forj=StartKnotTosize'
SizeX-1
从指定的节点开始，没有指定节点就从1开始
CallFindFourDots（known_x,known_y,j）'
找出输入X-Y点坐标里面，应该用于计算的四个结点
CallFindFourBezierPoints（Dot1,Dot2,Dot3,Dot4）
根据四个结点计算四个贝塞尔控制点
CallFindABCD
根据待查数值的类型，和贝塞尔控制点,计算贝塞尔插值多项式的系数
CallFind_t
检查贝塞尔曲线是否包含待查数值
IfInterpol_here=TrueThenExitFor
Nextj
IfInterpol_here=TrueThen
计算点坐标，并返回
以下是由四个贝塞尔控制点决定的,贝塞尔曲线的参数方程
x1Value=（1-t1）^3*BezierPt1.x+3*t1*（1-t1）^2*BezierPt2.x+3*t1^2*（1-t1）*BezierPt3.x+t1^3*BezierPt4.x
y1Value=（1-t1）^3*BezierPt1.y+3*t1*（1-t1）^2*BezierPt2.y+3*t1^2*（1-t1）*BezierPt3.y+t1^3*BezierPt4.y
x2Value=（1-t2）^3*BezierPt1.x+3*t2*（1-t2）^2*BezierPt2.x+3*t2^2*（1-t2）*BezierPt3.x+t2^3*BezierPt4.x
y2Value=（1-t2）^3*BezierPt1.y+3*t2*（1-t2）^2*BezierPt2.y+3*t2^2*（1-t2）*BezierPt3.y+t2^3*BezierPt4.y
x3Value=（1-t3）^3*BezierPt1.x+3*t3*（1-t3）^2*BezierPt2.x+3*t3^2*（1-t3）*BezierPt3.x+t3^3*BezierPt4.x
y3Value=（1-t3）^3*BezierPt1.y+3*t3*（1-t3）^2*BezierPt2.y+3*t3^2*（1-t3）*BezierPt3.y+t3^3*BezierPt4.y
result=Array（x1Value,y1Value,x2Value,y2Value,x3Value,y3Value）
Else
result=Array（Error10,Error10,Error10,Error10,Error10,Error10）
EndSub
FunctionErrorCheck（ByRefknown_x（）AsDouble,ByRefknown_y（）AsDouble,StartKnot）AsVariant
ErrorCheck=NoError
SizeX=UBound（known_x）'
known_x.Count
SizeY=UBound（known_y）'
known_y.Count
IfSizeX<
SizeYThen'
假如输入的X坐标数目不等于Y坐标数目
ErrorCheck=Error1
ExitFunction
3Then
输入的X-Y坐标对少于三个
ErrorCheck=Error2
If（StartKnot<
1OrStartKnot>
=SizeX）Then
指定的起始节点超出范围
ErrorCheck=Error3
If（ValueType<
AndValueType<
）Then
输入的待查数值类型不是x,y,t
ErrorCheck=Error4
If（（ValueType="
Andkey_value>
1）Or（ValueType="
Andkey_value<
0））Then
t类型的范围是0-1
ErrorCheck=Error5
EndFunction
SubFindFourDots（ByRefknown_x（）AsDouble,ByRefknown_y（）AsDouble,j）
根据X-Y数值，及起始节点，找出用于计算的四个结点坐标
Ifj=1Then
第一个结点Dot2=Dot1
Dot1.x=known_x
（1）
Dot1.y=known_y
（1）
Else
Dot1.x=known_x（j-1）
Dot1.y=known_y（j-1）
EndIf
Dot2.x=known_x（j）
Dot2.y=known_y（j）
Dot3.x=known_x（j+1）
Dot3.y=known_y（j+1）
Ifj=SizeX-1Then
最后一个结点Dot4=Dot3
Dot4.x=Dot3.x
Dot4.y=Dot3.y
Dot4.x=known_x（j+2）
Dot4.y=known_y（j+2）
SubFindFourBezierPoints（Dot1AsVector,Dot2AsVector,Dot3AsVector,Dot4AsVector）
Dimd12,d23,d34,d13,d14,d24AsDouble
d12=DistAtoB（Dot1,Dot2）
计算平面坐标系上的两点距离
d23=DistAtoB（Dot2,Dot3）
d34=DistAtoB（Dot3,Dot4）
d13=DistAtoB（Dot1,Dot3）
d14=DistAtoB（Dot1,Dot4）
d24=DistAtoB（Dot2,Dot4）
BezierPt1=Dot2
BezierPt4=Dot3
OffsetTo2=AsubB（Dot3,Dot1）
向量减法
OffsetTo3=AsubB（Dot2,Dot4）
If（（d13/6<
d23/2）And（d24/6<
d23/2））Then
If（Dot1.x<
Dot2.xOrDot1.y<
Dot2.y）ThenOffsetTo2=AmultiF（OffsetTo2,1/6）
If（Dot1.x=Dot2.xAndDot1.y=Dot2.y）ThenOffsetTo2=AmultiF（OffsetTo2,1/3）
If（Dot3.x<
Dot4.xOrDot3.y<
Dot4.y）ThenOffsetTo3=AmultiF（OffsetTo3,1/6）
If（Dot3.x=Dot4.xAndDot3.y=Dot4.y）ThenOffsetTo3=AmultiF（OffsetTo3,1/3）
ElseIf（（d13/6>
=d23/2）And（d24/6>
=d23/2））Then
OffsetTo2=AmultiF（OffsetTo2,d23/12）
OffsetTo3=AmultiF（OffsetTo3,d23/12）
ElseIf（d13/6>
=d23/2）Then
OffsetTo2=AmultiF（OffsetTo2,d23/2/d13）
OffsetTo3=AmultiF（OffsetTo3,d23/2/d13）
ElseIf（d24/6>
OffsetTo2=AmultiF（OffsetTo2,d23/2/d24）
OffsetTo3=AmultiF（OffsetTo3,d23/2/d24）
BezierPt2=AaddB（BezierPt1,OffsetTo2）
向量加法
BezierPt3=AaddB（BezierPt4,OffsetTo3）
FunctionDistAtoB（dotaAsVector,dotbAsVector）AsDouble
DistAtoB=（（dota.x-dotb.x）^2+（dota.y-dotb.y）^2）^0.5
FunctionAaddB（dotaAsVector,dotbAsVector）AsVector
AaddB.x=dota.x+dotb.x
AaddB.y=dota.y+dotb.y
FunctionAsubB（dotaAsVector,dotbAsVector）AsVector
AsubB.x=dota.x-dotb.x
AsubB.y=dota.y-dotb.y
FunctionAmultiF（dotaAsVector,MultiFactorAsDouble）AsVector
AmultiF.x=dota.x*MultiFactor
AmultiF.y=dota.y*MultiFactor
SubFindABCD（）
IfValueType="
Then
参数类型是x,需要解参数方程f（t）=x，这里设定参数方程的系数
a=-BezierPt1.x+3*BezierPt2.x-3*BezierPt3.x+BezierPt4.x
b=3*BezierPt1.x-6*BezierPt2.x+3*BezierPt3.x
c=-3*BezierPt1.x+3*BezierPt2.x
d=BezierPt1.x-key_value
参数类型是x,需要解参数方程f（t）=y，这里设定参数方程的系数
a=-BezierPt1.y+3*BezierPt2.y-3*BezierPt3
升级会员 