Line实体的排序问题。

兰州人

图1，在Acad中任意画4条line实体，顺序为1-3-2-4

 

其数据源为

619.5612	451.2518	0	969.7925	543.344	0	LineCount1
791.6046	846.225	0	486.4323	817.5741	0	LineCount2
791.6046	846.225	0	969.7925	543.344	0	LineCount3
486.4323	817.5741	0	619.5612	451.2518	0	LineCount4

要求经过对4条line的startpoint和endpoint重新排序，要求顺序为1-2-3-4

 

请问各位大侠有什么好的算法和公式。

兰州人

现在要经过首尾相连的算法，使顶点顺序为1-2-3-4
619.56119 451.25179  LineCount1
486.43234 817.5741  LineCount4
791.60463 846.22501  LineCount2
969.79248 543.34399  LineCount3
619.56119 451.25179  LineCount1

AutocadToTxt文件

2. Sub ll()
3.   ThisDrawing.ActiveTextStyle.fontFile = "c:\windows\fonts\SIMHEI.TTF"
4.   Dim LineData As AcadLine, ArcData As AcadArc
5.   Dim DrawingText As AcadText, DrawingCircle As AcadCircle
6.   Close #1
7.   Open "D:\ls.txt" For Output As #1
8.   
9.   Write #1, "m1", "m2", "m3", "m4", "m5", "m6", "m7", "m8", "m9", "m10", "m11", "m12"
10.   
11.   Dim Ent As AcadEntity
12.   ii = 1
13.   For Each Ent In ThisDrawing.ModelSpace
14.    
15.     m1 = Ent.ObjectName
16.     m2 = Ent.ObjectID
17.     Select Case Ent.ObjectName
18.       Case "AcDbLine"
19.         Set LineData = Ent
20.         
21.         With LineData
22.           'Set DrawingCircle = ThisDrawing.ModelSpace.AddCircle(.StartPoint, 35)
23.          
24.           m3 = Round(.StartPoint(0), 2)
25.           m4 = Round(.StartPoint(1), 2)
26.           m5 = Round(.StartPoint(2), 2)
27.           m6 = Round(.EndPoint(0), 2)
28.           m7 = Round(.EndPoint(1), 2)
29.           m8 = Round(.EndPoint(2), 2)
30.           ttt = "第" & ii & "点 " & "(" & m3 & "," & m4 & ")"
31.          
32.           Set DrawingText = ThisDrawing.ModelSpace.AddText(ttt, .EndPoint, 10)
33.           With DrawingText
34.             .Alignment = acAlignmentMiddleCenter
35.             .TextAlignmentPoint = LineData.StartPoint
36.             m9 = "第" & ii & "点"
37.             ii = ii + 1
38.           End With
39.          
40.         End With
41.     End Select
42.     Write #1, m1, m2, m3, m4, m5, m6, m7, m8, m9
43.    
44.   Next Ent
45.   
46.   Close #1
47. End Sub

Sub ll()   ThisDrawing.ActiveTextStyle.fontFile = "c:\windows\fonts\SIMHEI.TTF"   Dim LineData As AcadLine, ArcData As AcadArc   Dim DrawingText As AcadText, DrawingCircle As AcadCircle   Close #1   Open "D:\ls.txt" For Output As #1      Write #1, "m1", "m2", "m3", "m4", "m5", "m6", "m7", "m8", "m9", "m10", "m11", "m12"      Dim Ent As AcadEntity   ii = 1   For Each Ent In ThisDrawing.ModelSpace         m1 = Ent.ObjectName     m2 = Ent.ObjectID     Select Case Ent.ObjectName       Case "AcDbLine"         Set LineData = Ent                  With LineData           'Set DrawingCircle = ThisDrawing.ModelSpace.AddCircle(.StartPoint, 35)                     m3 = Round(.StartPoint(0), 2)           m4 = Round(.StartPoint(1), 2)           m5 = Round(.StartPoint(2), 2)           m6 = Round(.EndPoint(0), 2)           m7 = Round(.EndPoint(1), 2)           m8 = Round(.EndPoint(2), 2)           ttt = "第" & ii & "点 " & "(" & m3 & "," & m4 & ")"                     Set DrawingText = ThisDrawing.ModelSpace.AddText(ttt, .EndPoint, 10)           With DrawingText             .Alignment = acAlignmentMiddleCenter             .TextAlignmentPoint = LineData.StartPoint             m9 = "第" & ii & "点"             ii = ii + 1           End With                   End With     End Select     Write #1, m1, m2, m3, m4, m5, m6, m7, m8, m9       Next Ent      Close #1 End Sub

excel排序程序

2. Sub aaarrr()
3.   Dim rr(3, 5), rrr(4, 2)
4.   For ii = 6 To 9
5.     For jj = 3 To 7
6.       rr(ii - 6, jj - 3) = Sheet1.Cells(ii, jj)
7.     Next jj
8.   Next ii
9.   tt1 = rr(0, 0): tt2 = rr(0, 1)
10. For gg = 0 To UBound(rrr)
11.   For ii = 0 To UBound(rr)
12.     If ii <> gg Then
13.       If tt1 = rr(ii, 0) And tt2 = rr(ii, 1) Then
14.         rrr(gg, 0) = rr(ii, 3): rrr(gg, 1) = rr(ii, 4):
15.         tt1 = rrr(gg, 0): tt2 = rrr(gg, 1)
16.       ElseIf tt1 = rr(ii, 3) And tt2 = rr(ii, 4) Then
17.         rrr(gg, 0) = rr(ii, 0): rrr(gg, 1) = rr(ii, 1):
18.         tt1 = rrr(gg, 0): tt2 = rrr(gg, 1)
19.       End If
20.       
21.     End If
22.    
23.   Next ii
24.   
25.   For ii = 0 To UBound(rrr)
26.     For jj = 0 To 1
27.       Sheet1.Cells(ii + 16, jj + 6).Value = rrr(ii, jj)
28.     Next jj
29.   Next ii
30.   
31. Next gg
32. End Sub

Sub aaarrr()   Dim rr(3, 5), rrr(4, 2)   For ii = 6 To 9     For jj = 3 To 7       rr(ii - 6, jj - 3) = Sheet1.Cells(ii, jj)     Next jj   Next ii   tt1 = rr(0, 0): tt2 = rr(0, 1) For gg = 0 To UBound(rrr)   For ii = 0 To UBound(rr)     If ii <> gg Then       If tt1 = rr(ii, 0) And tt2 = rr(ii, 1) Then         rrr(gg, 0) = rr(ii, 3): rrr(gg, 1) = rr(ii, 4):         tt1 = rrr(gg, 0): tt2 = rrr(gg, 1)       ElseIf tt1 = rr(ii, 3) And tt2 = rr(ii, 4) Then         rrr(gg, 0) = rr(ii, 0): rrr(gg, 1) = rr(ii, 1):         tt1 = rrr(gg, 0): tt2 = rrr(gg, 1)       End If            End If       Next ii      For ii = 0 To UBound(rrr)     For jj = 0 To 1       Sheet1.Cells(ii + 16, jj + 6).Value = rrr(ii, jj)     Next jj   Next ii    Next gg End Sub