决定PL线偏移方向的正逆时针问题

lennie

CAD中规定PL线在Offset时，逆时针时偏移量正值时为放大。那么程序首先需要判断该PL线的方向，网上有一个算法如下：

2. Public Function GE_WhatPoly(ByVal oPLine As Object) As Integer
   
3. '   1   顺时针
   
4. '  -1   逆时针
   
5. '   0   无法判断
   
6.     Dim i As Integer
   
7.     Dim intHigh As Integer
   
8.     Dim dblArea As Double
   
9.     Dim arrPts() As Double
   
10.     arrPts = oPLine.Coordinates
    
11.     intHigh = UBound(arrPts)
    
12.     For i = 0 To intHigh - 2 Step 2
    
13.         dblArea = dblArea + (arrPts((i + 2) Mod (intHigh + 1)) - arrPts(i)) * (arrPts((i + 3) Mod (intHigh + 1)) + arrPts(i + 1))
    
14.     Next i
    
15.     GE_WhatPoly = IIf(dblArea > 0, 1, -1)
    
16.     If dblArea = 0 Then GE_WhatPoly = 0
    
17. End Function

Public Function GE_WhatPoly(ByVal oPLine As Object) As Integer<br /> '   1   顺时针<br /> '  -1   逆时针<br /> '   0   无法判断<br />     Dim i As Integer<br />     Dim intHigh As Integer<br />     Dim dblArea As Double<br />     Dim arrPts() As Double<br />     arrPts = oPLine.Coordinates<br />     intHigh = UBound(arrPts)<br />     For i = 0 To intHigh - 2 Step 2<br />         dblArea = dblArea + (arrPts((i + 2) Mod (intHigh + 1)) - arrPts(i)) * (arrPts((i + 3) Mod (intHigh + 1)) + arrPts(i + 1))<br />     Next i<br />     GE_WhatPoly = IIf(dblArea > 0, 1, -1)<br />     If dblArea = 0 Then GE_WhatPoly = 0<br /> End Function

经过测试大部分时候可以有效判断，但也有个别例外失效了。如附件：

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:示例.zip 
下载次数:12  文件大小:9.1 KB 
下载权限: 不限 以上  [免费赚D豆]

测试代码：

2. Public Function GE_WhatPoly(ByVal oPLine As Object) As Integer
   
3. '   1   顺时针
   
4. '  -1   逆时针
   
5. '   0   无法判断
   
6.     Dim i As Integer
   
7.     Dim intHigh As Integer
   
8.     Dim dblArea As Double
   
9.     Dim arrPts() As Double
   
10.     arrPts = oPLine.Coordinates
    
11.     intHigh = UBound(arrPts)
    
12.     For i = 0 To intHigh - 2 Step 2
    
13.         dblArea = dblArea + (arrPts((i + 2) Mod (intHigh + 1)) - arrPts(i)) * (arrPts((i + 3) Mod (intHigh + 1)) + arrPts(i + 1))
    
14.     Next i
    
15.     GE_WhatPoly = IIf(dblArea > 0, 1, -1)
    
16.     If dblArea = 0 Then GE_WhatPoly = 0
    
17. End Function
    
18. 
    
19. Public Sub a1()
    
20.     Dim GetEnt As Object
    
21.     Dim picPnt
    
22.     ThisDrawing.Utility.GetEntity GetEnt, picPnt, vbCr & _
    
23.             "  >>请拾取PL线："
    
24.     If Err.Number = "-2147352567" Then  'ESC or 没选中 or Enter
    
25.         ThisDrawing.Utility.Prompt vbCr & _
    
26.             "  >>结束！"
    
27.         Exit Sub
    
28.     Else
    
29.         Dim Temp As String
    
30.         Temp = IIf(GE_WhatPoly(GetEnt), "顺时针", "逆时针")
    
31.         MsgBox Temp
    
32.     End If
    
33. End Sub
    
34. 
    
35. Public Sub a2()         'PL线偏移（放大）300
    
36.     Dim GetEnt As Object
    
37.     Dim picPnt
    
38.     ThisDrawing.Utility.GetEntity GetEnt, picPnt, vbCr & _
    
39.             "  >>请拾取PL线："
    
40.     If Err.Number = "-2147352567" Then  'ESC or 没选中 or Enter
    
41.         ThisDrawing.Utility.Prompt vbCr & _
    
42.             "  >>结束！"
    
43.         Exit Sub
    
44.     Else
    
45.         GetEnt.Offset GE_WhatPoly(GetEnt) * -300
    
46.     End If
    
47. End Sub

Public Function GE_WhatPoly(ByVal oPLine As Object) As Integer<br /> '   1   顺时针<br /> '  -1   逆时针<br /> '   0   无法判断<br />     Dim i As Integer<br />     Dim intHigh As Integer<br />     Dim dblArea As Double<br />     Dim arrPts() As Double<br />     arrPts = oPLine.Coordinates<br />     intHigh = UBound(arrPts)<br />     For i = 0 To intHigh - 2 Step 2<br />         dblArea = dblArea + (arrPts((i + 2) Mod (intHigh + 1)) - arrPts(i)) * (arrPts((i + 3) Mod (intHigh + 1)) + arrPts(i + 1))<br />     Next i<br />     GE_WhatPoly = IIf(dblArea > 0, 1, -1)<br />     If dblArea = 0 Then GE_WhatPoly = 0<br /> End Function<br /> <br /> Public Sub a1()<br />     Dim GetEnt As Object<br />     Dim picPnt<br />     ThisDrawing.Utility.GetEntity GetEnt, picPnt, vbCr & _<br />             "  >>请拾取PL线："<br />     If Err.Number = "-2147352567" Then  'ESC or 没选中 or Enter<br />         ThisDrawing.Utility.Prompt vbCr & _<br />             "  >>结束！"<br />         Exit Sub<br />     Else<br />         Dim Temp As String<br />         Temp = IIf(GE_WhatPoly(GetEnt), "顺时针", "逆时针")<br />         MsgBox Temp<br />     End If<br /> End Sub<br /> <br /> Public Sub a2()         'PL线偏移（放大）300<br />     Dim GetEnt As Object<br />     Dim picPnt<br />     ThisDrawing.Utility.GetEntity GetEnt, picPnt, vbCr & _<br />             "  >>请拾取PL线："<br />     If Err.Number = "-2147352567" Then  'ESC or 没选中 or Enter<br />         ThisDrawing.Utility.Prompt vbCr & _<br />             "  >>结束！"<br />         Exit Sub<br />     Else<br />         GetEnt.Offset GE_WhatPoly(GetEnt) * -300<br />     End If<br /> End Sub

图中两根线实际测试时出错了。请高手来完善一下算法。
我现在用偏移之后的面积比较来区分实际偏移方向。

why1025

学习学习!!!!!!!!