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