VBA CAD判断多段线顶点顺序的顺时针、逆时针

chixun99

刚做一个小工具，判断多段线的顶点顺序方向（顺时针、逆时针）有需要的可自取。

1. Sub 查多段线方向()
   
2. '检查aen多段线是否为顶点顺时针的顺序,假设是2维lw多段线
   
3. Dim objPolyline As AcadLWPolyline
   
4. Dim ps1 As Variant
   
5. Dim p1 As Variant, p2 As Variant, p3 As Variant
   
6. Dim vc1 As Variant, vc2 As Variant
   
7. Dim i As Long, j As Long, k As Long
   
8. Dim m1 As Integer, m2 As Double
   
9. Dim bBegin As Boolean
   
10.     '处理多段线顶点坐标为数组
    
11.     'Set objPolyline = aEn
    
12.     ThisDrawing.Utility.GetEntity objPolyline, p1, "选择一个剪切框多段线:"
    
13.     ps1 = objPolyline.Coordinates
    
14.     For i = 0 To UBound(ps1) - 4 Step 2
    
15.         '遍历多段线的边，找到其中一条边的方向，
    
16.         '如所有顶点（不含该边）均在边的左边则逆时针
    
17.         '均在右边则顺时针,转换边端点为p1,p2数组
    
18.         p1 = Array(ps1(i), ps1(i + 1))
    
19.         p2 = Array(ps1(i + 2), ps1(i + 3))
    
20.         bBegin = True
    
21.         For j = 0 To UBound(ps1) Step 2
    
22.             '遍历其余点是否在边的某一边（左或右）
    
23.             '当出现左右均有顶点时，放弃此边作为判断依据
    
24.             If Not (j >= i And j <= i + 3) Then
    
25.                 p3 = Array(ps1(j), ps1(j + 1))
    
26.                 vc1 = c_Vectorize2P(p2, p1)
    
27.                 vc2 = c_Vectorize2P(p3, p1)
    
28.                 m2 = c_CrossProduct(vc1, vc2)
    
29.                 If bBegin Then
    
30.                     m1 = Sgn(m2)
    
31.                     bBegin = False
    
32.                 ElseIf Not m1 = Sgn(m2) Then
    
33.                     j = 0
    
34.                     Exit For
    
35.                 End If
    
36.             End If
    
37.         Next
    
38.         If j <> 0 Then Exit For
    
39.     Next
    
40.     If (m1 = -1) Then
    
41.         MsgBox "多段线顶点顺序为顺时针方向。"
    
42.     Else
    
43.         MsgBox "多段线顶点顺序为逆时针方向。"
    
44.     End If
    
45. End Sub
    
46. Private Function c_CrossProduct(vec1 As Variant, vec2 As Variant) As Double
    
47. '求向量的差积
    
48.     c_CrossProduct = vec1(0) * vec2(1) - vec1(1) * vec2(0)
    
49. End Function
    
50. Private Function c_Vectorize2P(p1 As Variant, p2 As Variant) As Variant
    
51. '2点转化为P1->P2向量数组
    
52.     c_Vectorize2P = Array(p1(0) - p2(0), p1(1) - p2(1))
    
53. End Function
    

Sub 查多段线方向() <br /> '检查aen多段线是否为顶点顺时针的顺序,假设是2维lw多段线<br /> Dim objPolyline As AcadLWPolyline<br /> Dim ps1 As Variant<br /> Dim p1 As Variant, p2 As Variant, p3 As Variant<br /> Dim vc1 As Variant, vc2 As Variant<br /> Dim i As Long, j As Long, k As Long<br /> Dim m1 As Integer, m2 As Double<br /> Dim bBegin As Boolean<br />     '处理多段线顶点坐标为数组<br />     'Set objPolyline = aEn<br />     ThisDrawing.Utility.GetEntity objPolyline, p1, "选择一个剪切框多段线:"<br />     ps1 = objPolyline.Coordinates<br />     For i = 0 To UBound(ps1) - 4 Step 2<br />         '遍历多段线的边，找到其中一条边的方向，<br />         '如所有顶点（不含该边）均在边的左边则逆时针<br />         '均在右边则顺时针,转换边端点为p1,p2数组<br />         p1 = Array(ps1(i), ps1(i + 1))<br />         p2 = Array(ps1(i + 2), ps1(i + 3))<br />         bBegin = True<br />         For j = 0 To UBound(ps1) Step 2<br />             '遍历其余点是否在边的某一边（左或右）<br />             '当出现左右均有顶点时，放弃此边作为判断依据<br />             If Not (j >= i And j <= i + 3) Then<br />                 p3 = Array(ps1(j), ps1(j + 1))<br />                 vc1 = c_Vectorize2P(p2, p1)<br />                 vc2 = c_Vectorize2P(p3, p1)<br />                 m2 = c_CrossProduct(vc1, vc2)<br />                 If bBegin Then<br />                     m1 = Sgn(m2)<br />                     bBegin = False<br />                 ElseIf Not m1 = Sgn(m2) Then<br />                     j = 0<br />                     Exit For<br />                 End If<br />             End If<br />         Next<br />         If j <> 0 Then Exit For<br />     Next<br />     If (m1 = -1) Then<br />         MsgBox "多段线顶点顺序为顺时针方向。"<br />     Else<br />         MsgBox "多段线顶点顺序为逆时针方向。"<br />     End If<br /> End Sub<br /> Private Function c_CrossProduct(vec1 As Variant, vec2 As Variant) As Double<br /> '求向量的差积<br />     c_CrossProduct = vec1(0) * vec2(1) - vec1(1) * vec2(0)<br /> End Function<br /> Private Function c_Vectorize2P(p1 As Variant, p2 As Variant) As Variant<br /> '2点转化为P1->P2向量数组<br />     c_Vectorize2P = Array(p1(0) - p2(0), p1(1) - p2(1))<br /> End Function<br />

jackAqwq

明经有你更精彩

tiancao100

给visualbasic点赞