[无聊]二维/三维坐标数组排序函数（单轴、双轴升降序）

Flyingdancing

2. Function orderXY(ByVal 点数组 As Variant, XY顺序 As String) As Variant
   
3. '根据坐标排序
   
4. '可设置单轴判断，也可设置双轴判断
   
5. '可升序，可降序
   
6. '*********************************************
   
7. 'XY顺序（分号分割）：（第一位）
   
8. ''''仅X——0
   
9. ''''仅Y——1
   
10. ''''先X后Y——2
    
11. ''''先Y后X——4
    
12. '''''''''第三位（先）：
    
13. '''''''''0——降序
    
14. '''''''''1——升序
    
15. '''''''''第二位（后）：
    
16. '''''''''0——降序
    
17. '''''''''1——升序
    
18. Dim 临时点 As Variant
    
19. Dim 中转变体 As Variant
    
20. Dim 计数i As Integer
    
21. Dim 计数j As Integer
    
22. Dim 先 As Integer
    
23. Dim 后 As Integer
    
24. Dim 变体 As Variant
    
25. Dim 升降序 As Integer
    
26. Dim 标志 As Integer '设置大于还是小于
    
27. '若只比较一个方向，则
    
28. '后=-1
    
29. 变体 = Split(XY顺序, ";") '分号分割
    
30. 
    
31. Select Case 变体(0)
    
32. Case 0
    
33.     先 = 0
    
34.     后 = -1
    
35. Case 1
    
36.     先 = 1
    
37.     后 = -1
    
38. Case 2
    
39.     先 = 0
    
40.     后 = 1
    
41. Case 4
    
42.     先 = 1
    
43.     后 = 0
    
44. End Select
    
45. 
    
46. '先顺序:
    
47. 升降序 = 变体(1)
    
48. For 计数i = 0 To UBound(点数组)
    
49.     For 计数j = 计数i + 1 To UBound(点数组)
    
50.         标志 = IIf(升降序, 点数组(计数i)(先) > 点数组(计数j)(先), 点数组(计数i)(先) < 点数组(计数j)(先))
    
51.         If 标志 Then '比较x坐标
    
52.             中转变体 = 点数组(计数i)
    
53.             点数组(计数i) = 点数组(计数j)
    
54.             点数组(计数j) = 中转变体
    
55.         End If
    
56.     Next
    
57. Next
    
58. If 后 = -1 Then GoTo 结束
    
59. 
    
60. '后顺序
    
61. 升降序 = 变体(2)
    
62. For 计数i = 0 To UBound(点数组)
    
63.     For 计数j = 计数i + 1 To UBound(点数组)
    
64.         
    
65.         If 点数组(计数i)(先) = 点数组(计数j)(先) Then
    
66.             标志 = IIf(升降序, 点数组(计数i)(后) > 点数组(计数j)(后), 点数组(计数i)(后) < 点数组(计数j)(后))
    
67.             If 标志 Then
    
68.                 中转变体 = 点数组(计数i)
    
69.                 点数组(计数i) = 点数组(计数j)
    
70.                 点数组(计数j) = 中转变体
    
71.             End If
    
72.         Else
    
73.             Exit For
    
74.         End If
    
75.     Next
    
76. Next
    
77. 结束:
    
78. orderXY = 点数组
    
79. End Function

Function orderXY(ByVal 点数组 As Variant, XY顺序 As String) As Variant<br /> '根据坐标排序<br /> '可设置单轴判断，也可设置双轴判断<br /> '可升序，可降序<br /> '*********************************************<br /> 'XY顺序（分号分割）：（第一位）<br /> ''''仅X——0<br /> ''''仅Y——1<br /> ''''先X后Y——2<br /> ''''先Y后X——4<br /> '''''''''第三位（先）：<br /> '''''''''0——降序<br /> '''''''''1——升序<br /> '''''''''第二位（后）：<br /> '''''''''0——降序<br /> '''''''''1——升序<br /> Dim 临时点 As Variant<br /> Dim 中转变体 As Variant<br /> Dim 计数i As Integer<br /> Dim 计数j As Integer<br /> Dim 先 As Integer<br /> Dim 后 As Integer<br /> Dim 变体 As Variant<br /> Dim 升降序 As Integer<br /> Dim 标志 As Integer '设置大于还是小于<br /> '若只比较一个方向，则<br /> '后=-1<br /> 变体 = Split(XY顺序, ";") '分号分割<br /> <br /> Select Case 变体(0)<br /> Case 0<br />     先 = 0<br />     后 = -1<br /> Case 1<br />     先 = 1<br />     后 = -1<br /> Case 2<br />     先 = 0<br />     后 = 1<br /> Case 4<br />     先 = 1<br />     后 = 0<br /> End Select<br /> <br /> '先顺序:<br /> 升降序 = 变体(1)<br /> For 计数i = 0 To UBound(点数组)<br />     For 计数j = 计数i + 1 To UBound(点数组)<br />         标志 = IIf(升降序, 点数组(计数i)(先) > 点数组(计数j)(先), 点数组(计数i)(先) < 点数组(计数j)(先))<br />         If 标志 Then '比较x坐标<br />             中转变体 = 点数组(计数i)<br />             点数组(计数i) = 点数组(计数j)<br />             点数组(计数j) = 中转变体<br />         End If<br />     Next<br /> Next<br /> If 后 = -1 Then GoTo 结束<br /> <br /> '后顺序<br /> 升降序 = 变体(2)<br /> For 计数i = 0 To UBound(点数组)<br />     For 计数j = 计数i + 1 To UBound(点数组)<br />         <br />         If 点数组(计数i)(先) = 点数组(计数j)(先) Then<br />             标志 = IIf(升降序, 点数组(计数i)(后) > 点数组(计数j)(后), 点数组(计数i)(后) < 点数组(计数j)(后))<br />             If 标志 Then<br />                 中转变体 = 点数组(计数i)<br />                 点数组(计数i) = 点数组(计数j)<br />                 点数组(计数j) = 中转变体<br />             End If<br />         Else<br />             Exit For<br />         End If<br />     Next<br /> Next<br /> 结束:<br /> orderXY = 点数组<br /> End Function

最终，可自行修改
或直接修改函数参数，变为传递选择集
否则使用前需提取点数组
或者可以修改select
使其支持Z轴排序（个人不使用，就没加）

vlisp2012

很好啊。可惜是VB的，要是lisp的就好了！

3xxx

学习了。

dpf200810

mark  谢谢lz

mycad

学习了，谢谢！