贝塞尔曲线及插值.docx
- 文档编号:7523829
- 上传时间:2023-05-11
- 格式:DOCX
- 页数:10
- 大小:83.01KB
贝塞尔曲线及插值.docx
《贝塞尔曲线及插值.docx》由会员分享,可在线阅读,更多相关《贝塞尔曲线及插值.docx(10页珍藏版)》请在冰点文库上搜索。
贝塞尔曲线及插值
贝塞尔曲线及插值
2010-07-0121:
41
贝塞尔曲线介绍可参考中文维基百科,图文并茂,这里就不啰嗦了http:
//zh.wikipedia.org/zh-cn/%E8%B2%9D%E8%8C%B2%E6%9B%B2%E7%B7%9A
这里主要讲一下如何在excel及vb中实现贝塞尔曲线插值,程序来源于互联网(程序作者:
海底眼(Mr.DragonPan在excel中用宏实现),本文作为少量修改,方便在vb中调用,经运行证明是没错的,下面程序可作成一个模块放到vb或vba中调用:
-------------------------------------------------------------------------------------
' Excel的平滑线散点图,可以根据两组分别代表X-Y坐标的散点数值产生曲线图
' 但是,却没有提供这个曲线图的公式,所以无法查找曲线上的点坐标
' 后来我在以下这个网页找到了详细的说明和示例程序
' ..............................................................................
'
' ..............................................................................
' 根据其中采用的算法,进一步增添根据X坐标求Y坐标,或根据Y坐标求X坐标,更切合实际需求
' 这个自定义函数按照Excel的曲线算法(三次贝塞尔分段插值),计算平滑曲线上任意一点的点坐标
'
' Excel的平滑曲线的大致算法是:
' 给出了两组X-Y数值以后,每一对X-Y坐标称为节点,然后在每两个节点之间画出三次贝塞尔曲线(下面简称曲线)
' 贝塞尔曲线的算法网上有很多资源,这里不介绍了,只作简单说明
' 每条曲线都由四个节点开始,计算出四个贝塞尔控制点,然后根据控制点画出唯一一条曲线
' 假设曲线的源数据是节点1,节点2,节点3,节点4(Dot1,Dot2,Dot3,Dot4)
' 那么贝塞尔控制点的计算如下
' Dot2是第一个控制点,也是曲点的起点,Dot3是第四个控制点也是曲线的终点
'
' 第二个控制点的位置是:
' 过第一个控制点(Dot2,起点),与Dot1,Dot3的连线平行,且与Dot2距离为1/6*线段Dot1_Dot3的长度
' 假如是图形的第一段曲线,取节点1,1,2,3进行计算,即Dot2=Dot1
' 且第二个控制点与第一控制点距离取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/2*|Dot2_Dot3|<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="Error:
Thesizeofknown_xmustequaltoorgreaterthan3"
ConstError3="Error:
StartKnotmustbe>=1and<=count(known_x)-1"
ConstError4="Error:
known_value_typemustbe""x"",""y"",or""t"""
ConstError5="Error:
Whenknown_value_typeis""t"",known_valuemust>=0and<=1"
ConstError10="Error:
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"代表输入的是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="x")
'
'--------------------------------------子过程方便VB中调用-----------------------------------------------------------
'主程序开始,至少要输入五个参数,第一个是X坐标系列,然后是Y坐标系列,第三个是坐标点数,第四个是待查数值,第五个是返回值
'第六个参数是从哪一段曲线开始查找,如果曲线可以返回多个值,那么分别指定起始节点就可以找出全部合要求的点
'第七个参数是待查数值的类型,"x"代表输入x坐标求对应y坐标,"y"则相反,"t"是直接输入贝塞尔插值多项式的参数
'-------------------------------------------------------------------------------------------------
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)
EndIf
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
EndIf
IfSizeX<3Then '输入的X-Y坐标对少于三个
ErrorCheck=Error2
ExitFunction
EndIf
If(StartKnot<1OrStartKnot>=SizeX)Then '指定的起始节点超出范围
ErrorCheck=Error3
ExitFunction
EndIf
If(ValueType<>"x"AndValueType<>"y"AndValueType<>"t")Then '输入的待查数值类型不是x,y,t
ErrorCheck=Error4
ExitFunction
EndIf
If((ValueType="t"Andkey_value>1)Or(ValueType="t"Andkey_value<0))Then 't类型的范围是0-1
ErrorCheck=Error5
ExitFunction
EndIf
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
Else
Dot4.x=known_x(j+2)
Dot4.y=known_y(j+2)
EndIf
EndSub
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 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>=d23/2)Then OffsetTo2=AmultiF(OffsetTo2,d23/2/d24) OffsetTo3=AmultiF(OffsetTo3,d23/2/d24) EndIf BezierPt2=AaddB(BezierPt1,OffsetTo2) '向量加法 BezierPt3=AaddB(BezierPt4,OffsetTo3) EndSub FunctionDistAtoB(dotaAsVector,dotbAsVector)AsDouble DistAtoB=((dota.x-dotb.x)^2+(dota.y-dotb.y)^2)^0.5 EndFunction FunctionAaddB(dotaAsVector,dotbAsVector)AsVector AaddB.x=dota.x+dotb.x AaddB.y=dota.y+dotb.y EndFunction FunctionAsubB(dotaAsVector,dotbAsVector)AsVector AsubB.x=dota.x-dotb.x AsubB.y=dota.y-dotb.y EndFunction FunctionAmultiF(dotaAsVector,MultiFactorAsDouble)AsVector AmultiF.x=dota.x*MultiFactor AmultiF.y=dota.y*MultiFactor EndFunction SubFindABCD() IfValueType="x"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 EndIf IfValueType="y"Then '参数类型是x,需要解参数方程f(t)=y,这里设定参数方程的系数 a=-BezierPt1.y+3*BezierPt2.y-3*BezierPt3
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 贝塞尔 曲线