[VBA程序]：如何确定方向？

luln

请教：如何确定多义线的顶点是按顺时针方向还是按逆时针方向排列？

XDSoft

最初由 luln 发布
[B]请教：如何确定多义线的顶点是按顺时针方向还是按逆时针方向排列？ [/B]

只有封闭的多义线才有”时针“方向，不知道你要做什么具体应用？

luln

我就是想判断封闭多义线的方向

XDSoft

最初由 luln 发布
[B]我就是想判断封闭多义线的方向 [/B]

给你贴个LISP代码，你把他们变成VBA程序吧，算法是利用行列式求顶点表构成的多边形的面积，如果面积为正（逆时针），如果面积为负（顺时针）。

实际应用中，你可以简化成求三角形的面积（第一点，倒数第二点，最后点）。

2. 
   
3. [FONT=courier new]
   
4. ;返回由顶点表 L1 构成的多边形面积.
   
5. ;Return area(x 2) of a polygon 'l1'.
   
6. (defun parea (l1 / s x1 y1 x2 y2 p1)
   
7.   (setq s 0. p1 (last l1) x1 (car p1) y1 (cadr p1))
   
8.   (foreach p1 l1
   
9.     (setq x2 (car p1) y2 (cadr p1) s (- (+ s (* x1 y2)) (* x2 y1)) x1 x2 y1 y2)
   
10.   )
    
11.   s
    
12. )[/FONT]

<br /> [FONT=courier new]<br /> ;返回由顶点表 L1 构成的多边形面积.<br /> ;Return area(x 2) of a polygon 'l1'.<br /> (defun parea (l1 / s x1 y1 x2 y2 p1)<br />   (setq s 0. p1 (last l1) x1 (car p1) y1 (cadr p1))<br />   (foreach p1 l1<br />     (setq x2 (car p1) y2 (cadr p1) s (- (+ s (* x1 y2)) (* x2 y1)) x1 x2 y1 y2)<br />   )<br />   s<br /> )[/FONT]

下面是求三角形的面积

2. 
   
3. [FONT=courier new]
   
4. ;返回三角形 p1p2p3 的面积.
   
5. ;Return area(x 2) of a triangle(p1 p2 p3).
   
6. (defun tarea (p1 p2 p3)
   
7.   (- (+ (* (car p1) (cadr p2)) (* (car p2) (cadr p3)) (* (car p3) (cadr p1)))
   
8.    (* (car p1) (cadr p3)) (* (car p2) (cadr p1)) (* (car p3) (cadr p2)))
   
9. )[/FONT]

<br /> [FONT=courier new]<br /> ;返回三角形 p1p2p3 的面积.<br /> ;Return area(x 2) of a triangle(p1 p2 p3).<br /> (defun tarea (p1 p2 p3)<br />   (- (+ (* (car p1) (cadr p2)) (* (car p2) (cadr p3)) (* (car p3) (cadr p1)))<br />    (* (car p1) (cadr p3)) (* (car p2) (cadr p1)) (* (car p3) (cadr p2)))<br /> )[/FONT]

luln

多谢晓东，我的问题终于解决了。

XDSoft

最初由 luln 发布
[B]多谢晓东，我的问题终于解决了。 [/B]

把解决的代码贴到论坛来吧，谢谢！

黄卫文

这样计算的面积好象不对

黄卫文

：）是我错了。计算出来的面积/2就是对的我没有看清：）
“判断封闭多义线的方向”这样判断对我也很有用非常谢谢

fjw_ok

最初由 XDSoft 发布
[B]

给你贴个LISP代码，你把他们变成VBA程序吧，算法是利用行列式求顶点表构成的多边形的面积，如果面积为正（逆时针），如果面积为?.. [/B]

vb 代码
Private Sub Command1_Click()
Dim x(50) As Single
Dim Y(50) As Single
Dim NUmBER As Integer
Dim I As Integer
Dim X1 As Single
Dim Y1 As Single
Dim X2 As Single
Dim Y2 As Single
Dim S As Variant
Dim temp As Single
Dim fname As Variant
fname = fn.FileName
fn.ShowOpen
Open fn.FileName For Input As #1

Do While Not EOF(1)
Input #1, temp, temp
NUmBER = NUmBER + 1
Loop
Close #1
Open fn.FileName For Input As #1
For I = 1 To NUmBER
Input #1, x(I), Y(I)
Next I
Close #1

S = 0
X1 = x(NUmBER)
Y1 = Y(NUmBER)
For I = 1 To NUmBER

X2 = x(I)
Y2 = Y(I)
S = (S + X1 * Y2) - (X2 * Y1)
X1 = X2
Y1 = Y2
Next I
S = S / 2
MsgBox "AREA IS " & S

End Sub

Private Sub Command2_Click()
quit
End Sub