求两直线交点的vba源代码

xs__wang

求两直线交点的vba源代码

lee_12345

我写一段吧: '判别一个点在直线上的方向
'本函数为判别一个点（X，Y）在直线（x1,y1)(x2,y2)上的方向
'返回值>0:为正方向区；返回值=0:为该点在直线上；返回值<0:为负方向区； Function Fang(X As Single, Y As Single, x1 As Single, y1 As Single, x2 As Single, y2 As Single) As Long
'返回方向
Dim AA As Single'A
Dim BB As Single'B
Dim cc As Single'临时
cc = x2 - x1
If cc = 0 Then
Fang = Sgn(X - x1) '返回方向
Exit Function
Else
AA = (y2 - y1) / (cc)
BB = (y1 * x2 - y2 * x1) / (cc)
Fang = Sgn(Y - AA * X - BB) '返回方向
End If
End Function
'求两直线段的交点
'本函数返回两直线段是否有交点，交点坐标为（X，Y）,用到FANG函数
'第一线段：（Px1,Py1)(Px2,Py2)
'第二线段：（x1,y1)(x2,y2)
'求得交点：（X，Y）
Private Function Point_4(Px1 As Single, Py1 As Single, Px2 As Single, Py2 As Single, x1 As Single, y1 As Single, x2 As Single, y2 As Single, X As Single, Y As Single) As Boolean 'Ｘ和Ｙ是返回坐标
Dim A1 As Single, B1 As Single, C1 As Single
Dim A2 As Single, B2 As Single, C2 As Single
Dim fanxiang1 As Long '方向1
Dim fanxiang2 As Long '方向2
Dim fanxiang3 As Long '方向3
Dim fanxiang4 As Long '方向4
fanxiang1 = Fang(Px1, Py1, x1, y1, x2, y2)'判别方向,函数见开始几行.
fanxiang2 = Fang(Px2, Py2, x1, y1, x2, y2)'判别方向
fanxiang3 = Fang(x1, y1, Px1, Py1, Px2, Py2)'判别方向
fanxiang4 = Fang(x2, y2, Px1, Py1, Px2, Py2)'判别方向
If fanxiang1 <> fanxiang2 And fanxiang3 <> fanxiang4 Then
'若每两点分别在另两点两边，则有相交点。
A1 = y2 - y1
B1 = x1 - x2
C1 = A1 * x1 + B1 * y1
A2 = Py2 - Py1
B2 = Px1 - Px2
C2 = A2 * Px1 + B2 * Py1
X = (C1 * B2 - B1 * C2) / (A1 * B2 - A2 * B1)
Y = (A1 * C2 - C1 * A2) / (A1 * B2 - A2 * B1)
Point_4 = True '返回有交点
End If
End Function

lee_12345

不明白,就联系:lee_12345@tom.com吧.

mccad

[WEB]/object/acad2004/idh_intersectwith.htm[/WEB]

齿轮设计

明经通道的帮助翻译得真不错，有地方下载吗？花钱也行啊