求两直线交点的vba源代码
求两直线交点的vba源代码 我写一段吧:'判别一个点在直线上的方向<BR>'本函数为判别一个点（X，Y）在直线（x1,y1)(x2,y2)上的方向<BR>'返回值>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<BR> '返回方向<BR> Dim AA As Single'A<BR> Dim BB As Single'B<BR> Dim cc As Single'临时<BR> cc = x2 - x1<BR> If cc = 0 Then<BR> Fang = Sgn(X - x1) '返回方向<BR> Exit Function<BR> Else<BR> AA = (y2 - y1) / (cc)<BR> BB = (y1 * x2 - y2 * x1) / (cc)<BR> Fang = Sgn(Y - AA * X - BB) '返回方向<BR> End If<BR>End Function <BR>
'求两直线段的交点 <BR>'本函数返回两直线段是否有交点，交点坐标为（X，Y）,用到FANG函数<BR>'第一线段：（Px1,Py1)(Px2,Py2)<BR>'第二线段：（x1,y1)(x2,y2)<BR>'求得交点：（X，Y） <BR>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 'Ｘ和Ｙ是返回坐标<BR> Dim A1 As Single, B1 As Single, C1 As Single<BR> Dim A2 As Single, B2 As Single, C2 As Single<BR> Dim fanxiang1 As Long '方向1<BR> Dim fanxiang2 As Long '方向2<BR> Dim fanxiang3 As Long '方向3<BR> Dim fanxiang4 As Long '方向4<BR> fanxiang1 = Fang(Px1, Py1, x1, y1, x2, y2)'判别方向,函数见开始几行.<BR> fanxiang2 = Fang(Px2, Py2, x1, y1, x2, y2)'判别方向<BR> fanxiang3 = Fang(x1, y1, Px1, Py1, Px2, Py2)'判别方向<BR> fanxiang4 = Fang(x2, y2, Px1, Py1, Px2, Py2)'判别方向<BR> If fanxiang1 <> fanxiang2 And fanxiang3 <> fanxiang4 Then<BR> '若每两点分别在另两点两边，则有相交点。<BR> A1 = y2 - y1<BR> B1 = x1 - x2<BR> C1 = A1 * x1 + B1 * y1<BR> A2 = Py2 - Py1<BR> B2 = Px1 - Px2<BR> C2 = A2 * Px1 + B2 * Py1<BR> X = (C1 * B2 - B1 * C2) / (A1 * B2 - A2 * B1)<BR> Y = (A1 * C2 - C1 * A2) / (A1 * B2 - A2 * B1)<BR> Point_4 = True '返回有交点<BR> End If<BR>End Function<BR> 不明白,就联系:lee_12345@tom.com吧. /object/acad2004/idh_intersectwith.htm 明经通道的帮助翻译得真不错，有地方下载吗？花钱也行啊
页:
[1]