主题：[讨论]求助啊！！关于求两条线段间角度差的问题，类似于量角器！
VB孙小圣
[专家分：0] 发布于 2009-03-20 18:37:00
请教各位大哥，小弟正在做一个程序，现遇到极度难题一个，应该属于算法一类，特此虚心求教！程序发在附件里了，现描述一下：按下Command1，得到图像1及其中轴线，按下Command2，得到图像2及其中轴线，欲按下Command3得到图像1与图像2中轴线的角度差（图上可能比较难理解，实际情况是这两条中轴线的下半部分几乎重合，即从第5行或第6行开始其实是相同的，有差别的部分只是存在于第4行或第5行以上，爷就是只有中轴线的上半部分有角度差，所以只需求出上半部分的角度差别）。不知各位高手有没看懂小弟的意思呢？ 急求解法啊，小弟郁闷一个月了！！
最后更新于：2009-03-20 19:36:00
回复列表 （共11个回复）
沙发
VB孙小圣 [专家分：0] 发布于 2009-03-20 19:25:00
没有高手会么？小弟飙泪在线等啊！！请斑竹帮帮忙啊！
板凳
VB孙小圣 [专家分：0] 发布于 2009-03-20 19:34:00
上传的文件怎么看不到啊？
3 楼
VB孙小圣 [专家分：0] 发布于 2009-03-20 19:37:00
附件已经上传成功了，请高手指点
4 楼
rzfc [专家分：230] 发布于 2009-03-20 20:29:00
这应该是解析几何的问题。既然已经得到了两根线了，这两根线就是两个向量，可以分别表示为A，B，则夹角cosθ＝A*B/（|A|*|B|），A*B为两向量内积，|A|和|B|分别是其长度。可以参考一下解析几何教材
5 楼
VB孙小圣 [专家分：0] 发布于 2009-03-21 10:05:00
[quote]
这应该是解析几何的问题。既然已经得到了两根线了，这两根线就是两个向量，可以分别表示为A，B，则夹角cosθ＝A*B/（|A|*|B|），A*B为两向量内积，|A|和|B|分别是其长度。可以参考一下解析几何教材
[/quote]
可是对应到VB里面是什么语句呢？小弟学VB两个月，这个问题愁死我了，能否帮忙写几句代码呢？
6 楼
VB孙小圣 [专家分：0] 发布于 2009-03-21 12:21:00
版主，各位高手，帮帮忙啊~
7 楼
天天学习 [专家分：4570] 发布于 2009-03-21 15:59:00
[code=c]Option Explicit
Private Function calcAngle(ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single, _
ByVal x3 As Single, ByVal y3 As Single, ByVal x4 As Single, ByVal y4 As Single) As Single
'* 功能：计算两条直线的夹角，以角度表示.
'* 输入：x1,y1：第一条直线上的一个点
'* x2,y2：第一条直线上的另一个点
'* x3,y3：第二条直线上的一个点
'* x4,y4：第二条直线上的另一个点
'* 输出：两条直线的夹角，以角度表示
'* *************************************
Dim PI As Single
Dim tanA As Single
Dim tanB As Single
Dim a As Single
Dim b As Single
Dim c As Single
PI = 3.1415926
If x1 - x2 = 0 Then
tanA = Tan(90 / 180 * PI) '垂直于X轴，下同
Else
tanA = (y1 - y2) / (x1 - x2) '该直线与X轴的夹角的正切值，下同
End If
If x3 - x4 = 0 Then
tanB = Tan(90 / 180 * PI)
Else
tanB = (y3 - y4) / (x3 - x4)
End If
If tanA * tanB = 1 Then calcAngle = 90: Exit Function '垂直
If tanA = tanB Then calcAngle = 0: Exit Function '平行
a = Atn(tanA)
b = Atn(tanB)
c = 180 * (PI - a - b) / PI
If c > 90 Then c = c - 90
calcAngle = c
End Function
Private Sub Command1_Click()
Picture1.Scale (0, 100)-(100, 0)
'互相垂直
Picture1.Line (10, 20)-(80, 20) '平行于X轴的直线
Picture1.Line (40, 10)-(40, 80) '平行于Y轴的直线
Debug.Print calcAngle(10, 20, 80, 20, 40, 80, 40, 10)
Debug.Print calcAngle(80, 20, 10, 20, 40, 80, 40, 10) '同一条线上的两点在传入参数时的先后顺序是否有影响：无
Picture1.ForeColor = vbBlue
Picture1.Line (0, 0)-(80, 80) '对角垂直
Picture1.Line (0, 80)-(80, 0)
Debug.Print calcAngle(0, 0, 80, 80, 0, 80, 80, 0)
'非垂直，非平行
Picture1.ForeColor = vbRed
Picture1.Line (0, 0)-(50 * Sqr(3), 50) '30度角
Picture1.Line (0, 0)-(60, 60) '45度角
Debug.Print calcAngle(0, 0, 50 * Sqr(3), 50, 0, 0, 60, 60) '15度
'互相平行
Picture1.ForeColor = vbGreen
Picture1.Line (10, 50)-(80, 50)
Picture1.Line (10, 40)-(80, 40)
Debug.Print calcAngle(10, 50, 80, 50, 10, 40, 80, 40)
Picture1.ForeColor = vbCyan
Picture1.Line (20, 80)-(20, 10)
Picture1.Line (80, 80)-(80, 10)
Debug.Print calcAngle(20, 80, 20, 10, 80, 80, 80, 10)
End Sub
[/code]
8 楼
天天学习 [专家分：4570] 发布于 2009-03-21 17:40:00
修正：
在上面的代码中增加一个测试：
Picture1.ForeColor = vbYellow
Picture1.Line (0, 0)-(80 * Sqr(3), 80) '30度角
Picture1.Line (0, 80)-(80 * Sqr(3), 0) '-30度角
Debug.Print calcAngle(0, 0, 80 * Sqr(3), 80, 0, 80, 80 * Sqr(3), 0)
得不到正确结果60
函数修正如下：
[code=c]
Private Function calcAngle(ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single, _
ByVal x3 As Single, ByVal y3 As Single, ByVal x4 As Single, ByVal y4 As Single) As Single
'* 功能：计算两条直线的夹角，以角度表示.
'* 输入：x1,y1：第一条直线上的一个点
'* x2,y2：第一条直线上的另一个点
'* x3,y3：第二条直线上的一个点
'* x4,y4：第二条直线上的另一个点
'* 输出：两条直线的夹角，以角度表示
'* *************************************
Dim PI As Single
Dim tanA As Single
Dim tanB As Single
Dim a As Single
Dim b As Single
Dim c As Single
PI = 3.1415926
If x1 - x2 = 0 Then
tanA = Tan(90 / 180 * PI) '垂直于X轴，下同
Else
tanA = (y1 - y2) / (x1 - x2) '该直线与X轴的夹角的正切值，下同
End If
If x3 - x4 = 0 Then
tanB = Tan(90 / 180 * PI)
Else
tanB = (y3 - y4) / (x3 - x4)
End If
a = Atn(tanA)
b = Atn(tanB)
If (a * b < 0) Then
'一个正角，一个负角
c = 180 * (Abs(a) + Abs(b)) / PI
Else
'两个正角，或者两个负角
c = 180 * Abs(Abs(a) - Abs(b)) / PI
End If
calcAngle = c
End Function
[/code]
9 楼
天天学习 [专家分：4570] 发布于 2009-03-21 18:55:00
按解析几何的向量乘法的算法：
关于三角函数公式，参考 http://www.521yy.com/tools/maths/
关于向量内积，参考 http://caterpillar.onlyfun.net/Gossip/ComputerGraphics/AboutVector.htm
[code=c]Private Function calcAngle2(ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single, _
ByVal x3 As Single, ByVal y3 As Single, ByVal x4 As Single, ByVal y4 As Single) As Single
'* 功能：计算两条直线的夹角，以角度表示.
'* 输入：x1,y1：第一条直线上的一个点
'* x2,y2：第一条直线上的另一个点
'* x3,y3：第二条直线上的一个点
'* x4,y4：第二条直线上的另一个点
'* 输出：两条直线的夹角，以角度表示
'* *************************************
Dim cosA As Single
Dim tanA2 As Single
Dim a As Single
Dim pi As Single
pi = 3.1415926
cosA = ((x2 - x1) * (x4 - x3) + (y2 - y1) * (y4 - y3)) / (Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2) * Sqr((x4 - x3) ^ 2 + (y4 - y3) ^ 2))
tanA2 = Sqr((1 - cosA) / (1 + cosA))
a = (180 * Atn(tanA2) / pi) * 2
calcAngle2 = a
End Function
[/code]
10 楼
VB孙小圣 [专家分：0] 发布于 2009-03-22 14:43:00
[quote]按解析几何的向量乘法的算法：
关于三角函数公式，参考 http://www.521yy.com/tools/maths/
关于向量内积，参考 http://caterpillar.onlyfun.net/Gossip/ComputerGraphics/AboutVector.htm
[code=c]Private Function calcAngle2(ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single, _
ByVal x3 As Single, ByVal y3 As Single, ByVal x4 As Single, ByVal y4 As Single) As Single
'* 功能：计算两条直线的夹角，以角度表示.
'* 输入：x1,y1：第一条直线上的一个点
'* x2,y2：第一条直线上的另一个点
'* x3,y3：第二条直线上的一个点
'* x4,y4：第二条直线上的另一个点
'* 输出：两条直线的夹角，以角度表示
'* *************************************
Dim cosA As Single
Dim tanA2 As Single
Dim a As Single
Dim pi As Single
pi = 3.1415926
cosA = ((x2 - x1) * (x4 - x3) + (y2 - y1) * (y4 - y3)) / (Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2) * Sqr((x4 - x3) ^ 2 + (y4 - y3) ^ 2))
tanA2 = Sqr((1 - cosA) / (1 + cosA))
a = (180 * Atn(tanA2) / pi) * 2
calcAngle2 = a
End Function
[/code][/quote]
谢谢这位高手啊，可是还有一个问题哦，小弟是用shape控件画图的，那应该怎么编程呢？能否结合程序帮我修改一下呢？谢谢啊
我来回复
您所在位置：