[VBA]关于点阵非交叉连线问题的算法及实现(非穷举法).

zeng29

问题的提出:
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=13701

代码:

2. Option Explicit
   
3. 
   
4. Const CLEARCMD = vbCr & "        " & vbCr
   
5. Dim Pi As Double
   
6. 
   
7. Public Sub LinePointArray()
   
8.     Dim PointArray() As Double, PointIndex() As Integer, CurPIndex As Integer
   
9.     Dim i As Integer, N As Integer
   
10.     Dim TempPoint As Variant, Temp As Variant, TempIndex As Integer
    
11.     Dim StartPoint(0 To 2) As Double
    
12.     Dim TempAngle As Double
    
13.     Dim ii As Integer
    
14.     Dim BasePoint(0 To 2) As Double, SecendPoint(0 To 2) As Double
    
15.     Dim P1(0 To 2) As Double, P2(0 To 2) As Double
    
16.     Dim BaseAngle As Double, Direction As Integer
    
17.    
    
18.     Pi = Atn(1) * 4
    
19.     On Error Resume Next
    
20.     'Open "D:\Test.txt" For Output As #1
    
21.     Do
    
22.         ReDim Preserve PointArray(0 To 2, N)
    
23.         TempPoint = ThisDrawing.Utility.GetPoint(, CLEARCMD & "请选择点(" & N & "):")
    
24.         If Err Then
    
25.             Err.Clear
    
26.             N = N - 1
    
27.             If N <= 0 Then Exit Sub
    
28.             Exit Do
    
29.         End If
    
30.         PointArray(0, N) = TempPoint(0)
    
31.         PointArray(1, N) = TempPoint(1)
    
32.         ThisDrawing.ModelSpace.AddText N, TempPoint, 5
    
33.         'Print #1, "点" & N & ":" & TempPoint(0) & "," & TempPoint(1)
    
34.         N = N + 1
    
35.     Loop
    
36.    
    
37.     On Error GoTo 0
    
38.     Temp = PointArray(0, 0)
    
39.     For i = 1 To N
    
40.         If Temp >= PointArray(0, i) Then
    
41.             Temp = PointArray(0, i)
    
42.             TempIndex = i
    
43.         End If
    
44.     Next i
    
45.     StartPoint(0) = PointArray(0, TempIndex)
    
46.     StartPoint(1) = PointArray(1, TempIndex)
    
47.     BasePoint(0) = StartPoint(0)
    
48.     BasePoint(1) = StartPoint(1)
    
49.     CurPIndex = TempIndex
    
50.     ReDim PointIndex(0)
    
51.     PointIndex(0) = TempIndex
    
52.     Direction = 1
    
53.     BaseAngle = 270
    
54.     TempAngle = 360
    
55.     For i = 1 To N
    
56.         For ii = 0 To N
    
57.             If (ii = PointIndex(0) And CurPIndex <> PointIndex(0)) Or (ii <> CurPIndex And (Not IsIn(ii, PointIndex))) Then
    
58.                 SecendPoint(0) = PointArray(0, ii)
    
59.                 SecendPoint(1) = PointArray(1, ii)
    
60.                 Temp = GetAngle(BasePoint, SecendPoint, BaseAngle, Direction)
    
61.                 'Print #1, CurPIndex & "," & ii & ":" & Temp
    
62.                 If Temp <= TempAngle Then
    
63.                     TempAngle = Temp
    
64.                     TempIndex = ii
    
65.                 End If
    
66.             End If
    
67.         Next ii
    
68.         If TempIndex = PointIndex(0) Then
    
69.             Direction = (-1) * Direction
    
70.             i = i - 1
    
71.             TempAngle = 360
    
72.         Else
    
73.             P1(0) = PointArray(0, PointIndex(UBound(PointIndex)))
    
74.             P1(1) = PointArray(1, PointIndex(UBound(PointIndex)))
    
75.             ReDim Preserve PointIndex(UBound(PointIndex) + 1)
    
76.             PointIndex(UBound(PointIndex)) = TempIndex
    
77.             P2(0) = PointArray(0, PointIndex(UBound(PointIndex)))
    
78.             P2(1) = PointArray(1, PointIndex(UBound(PointIndex)))
    
79.             BaseAngle = GetAngle(BasePoint, P2)
    
80.             CurPIndex = TempIndex
    
81.             BasePoint(0) = PointArray(0, CurPIndex)
    
82.             BasePoint(1) = PointArray(1, CurPIndex)
    
83.             TempAngle = 360
    
84.             ThisDrawing.ModelSpace.AddLine P1, P2
    
85.             ThisDrawing.Application.Update
    
86.         End If
    
87.     Next i
    
88.     P1(0) = PointArray(0, CurPIndex)
    
89.     P1(1) = PointArray(1, CurPIndex)
    
90.     ThisDrawing.ModelSpace.AddLine P1, StartPoint
    
91.     'Close #1
    
92. End Sub
    
93. 
    
94. Private Function IsIn(Element As Integer, DataArray) As Boolean
    
95.     Dim i As Integer
    
96.     For i = 0 To UBound(DataArray)
    
97.         If Element = DataArray(i) Then
    
98.             IsIn = True
    
99.             Exit Function
    
100.         End If
     
101.     Next i
     
102.     IsIn = False
     
103. End Function
     
104. 
     
105. Private Function GetAngle(BasePoint, SecendPoint, Optional BaseAngle As Double = 0, Optional Direction As Integer = 1) As Double
     
106.     Dim Angle As Double
     
107.     If SecendPoint(0) = BasePoint(0) Then
     
108.         If SecendPoint(1) > BasePoint(1) Then
     
109.             Angle = 90
     
110.         Else
     
111.             Angle = -90
     
112.         End If
     
113.     Else
     
114.         Angle = (Atn((SecendPoint(1) - BasePoint(1)) / (SecendPoint(0) - BasePoint(0)))) * 180 / Pi
     
115.     End If
     
116.     If SecendPoint(0) > BasePoint(0) Then
     
117.         Angle = 360 + Angle                    '1,4
     
118.     Else
     
119.         Angle = 180 + Angle                    '2,3
     
120.     End If
     
121.     GetAngle = (Angle - BaseAngle) * Direction
     
122.     If GetAngle < 0 Then GetAngle = GetAngle + 360
     
123. End Function
     

Option Explicit<br /> <br /> Const CLEARCMD = vbCr & "        " & vbCr<br /> Dim Pi As Double<br /> <br /> Public Sub LinePointArray()<br />     Dim PointArray() As Double, PointIndex() As Integer, CurPIndex As Integer<br />     Dim i As Integer, N As Integer<br />     Dim TempPoint As Variant, Temp As Variant, TempIndex As Integer<br />     Dim StartPoint(0 To 2) As Double<br />     Dim TempAngle As Double<br />     Dim ii As Integer<br />     Dim BasePoint(0 To 2) As Double, SecendPoint(0 To 2) As Double<br />     Dim P1(0 To 2) As Double, P2(0 To 2) As Double<br />     Dim BaseAngle As Double, Direction As Integer<br />     <br />     Pi = Atn(1) * 4<br />     On Error Resume Next<br />     'Open "D:\Test.txt" For Output As #1<br />     Do<br />         ReDim Preserve PointArray(0 To 2, N)<br />         TempPoint = ThisDrawing.Utility.GetPoint(, CLEARCMD & "请选择点(" & N & "):")<br />         If Err Then<br />             Err.Clear<br />             N = N - 1<br />             If N <= 0 Then Exit Sub<br />             Exit Do<br />         End If<br />         PointArray(0, N) = TempPoint(0)<br />         PointArray(1, N) = TempPoint(1)<br />         ThisDrawing.ModelSpace.AddText N, TempPoint, 5<br />         'Print #1, "点" & N & ":" & TempPoint(0) & "," & TempPoint(1)<br />         N = N + 1<br />     Loop<br />     <br />     On Error GoTo 0<br />     Temp = PointArray(0, 0)<br />     For i = 1 To N<br />         If Temp >= PointArray(0, i) Then<br />             Temp = PointArray(0, i)<br />             TempIndex = i<br />         End If<br />     Next i<br />     StartPoint(0) = PointArray(0, TempIndex)<br />     StartPoint(1) = PointArray(1, TempIndex)<br />     BasePoint(0) = StartPoint(0)<br />     BasePoint(1) = StartPoint(1)<br />     CurPIndex = TempIndex<br />     ReDim PointIndex(0)<br />     PointIndex(0) = TempIndex<br />     Direction = 1<br />     BaseAngle = 270<br />     TempAngle = 360<br />     For i = 1 To N<br />         For ii = 0 To N<br />             If (ii = PointIndex(0) And CurPIndex <> PointIndex(0)) Or (ii <> CurPIndex And (Not IsIn(ii, PointIndex))) Then<br />                 SecendPoint(0) = PointArray(0, ii)<br />                 SecendPoint(1) = PointArray(1, ii)<br />                 Temp = GetAngle(BasePoint, SecendPoint, BaseAngle, Direction)<br />                 'Print #1, CurPIndex & "," & ii & ":" & Temp<br />                 If Temp <= TempAngle Then<br />                     TempAngle = Temp<br />                     TempIndex = ii<br />                 End If<br />             End If<br />         Next ii<br />         If TempIndex = PointIndex(0) Then<br />             Direction = (-1) * Direction<br />             i = i - 1<br />             TempAngle = 360<br />         Else<br />             P1(0) = PointArray(0, PointIndex(UBound(PointIndex)))<br />             P1(1) = PointArray(1, PointIndex(UBound(PointIndex)))<br />             ReDim Preserve PointIndex(UBound(PointIndex) + 1)<br />             PointIndex(UBound(PointIndex)) = TempIndex<br />             P2(0) = PointArray(0, PointIndex(UBound(PointIndex)))<br />             P2(1) = PointArray(1, PointIndex(UBound(PointIndex)))<br />             BaseAngle = GetAngle(BasePoint, P2)<br />             CurPIndex = TempIndex<br />             BasePoint(0) = PointArray(0, CurPIndex)<br />             BasePoint(1) = PointArray(1, CurPIndex)<br />             TempAngle = 360<br />             ThisDrawing.ModelSpace.AddLine P1, P2<br />             ThisDrawing.Application.Update<br />         End If<br />     Next i<br />     P1(0) = PointArray(0, CurPIndex)<br />     P1(1) = PointArray(1, CurPIndex)<br />     ThisDrawing.ModelSpace.AddLine P1, StartPoint<br />     'Close #1<br /> End Sub<br /> <br /> Private Function IsIn(Element As Integer, DataArray) As Boolean<br />     Dim i As Integer<br />     For i = 0 To UBound(DataArray)<br />         If Element = DataArray(i) Then<br />             IsIn = True<br />             Exit Function<br />         End If<br />     Next i<br />     IsIn = False<br /> End Function<br /> <br /> Private Function GetAngle(BasePoint, SecendPoint, Optional BaseAngle As Double = 0, Optional Direction As Integer = 1) As Double<br />     Dim Angle As Double<br />     If SecendPoint(0) = BasePoint(0) Then<br />         If SecendPoint(1) > BasePoint(1) Then<br />             Angle = 90<br />         Else<br />             Angle = -90<br />         End If<br />     Else<br />         Angle = (Atn((SecendPoint(1) - BasePoint(1)) / (SecendPoint(0) - BasePoint(0)))) * 180 / Pi<br />     End If<br />     If SecendPoint(0) > BasePoint(0) Then<br />         Angle = 360 + Angle                    '1,4<br />     Else<br />         Angle = 180 + Angle                    '2,3<br />     End If<br />     GetAngle = (Angle - BaseAngle) * Direction<br />     If GetAngle < 0 Then GetAngle = GetAngle + 360<br /> End Function<br />

例图:

myfreemind

试用了一下，图中的点是要展进去的吗？怎么运行程序以后要一个一个的选择点呢？

myfreemind

图中的点可否环型连接？由外向内，顺时针或逆时针均可，这样的话就可以首尾相接而且不交叉！如图:

zeng29

本程序要做的是 :1首尾相连;2点与点之间的连接;3不能交叉
所以3楼所示的图形是不符合的.(首尾连接必交叉)

myfreemind

zeng29发表于2003-12-15 10:33:00本程序要做的是 :1首尾相连;2点与点之间的连接;3不能交叉
所以3楼所示的图形是不符合的.(首尾连接必交叉)

是这样，明白了！我想问一下，你的程序运行要选择点是怎么回事？不选择的话没有办法将图中的点连接起来吗？对于图中的点有什么要求没有？

zeng29

点阵的连线,自然要先确定点阵的数据.(这里是根据操作者选择的点进行连接)
对选择的点没有要求.数量和位置由操作者拾取.

myfreemind

明白了！！谢谢！

莫名

这好象没有唯一的解！