[无聊]二维/三维坐标数组排序函数（单轴、双轴升降序）
本帖最后由 Flyingdancing 于 2012-12-3 21:19 编辑Function orderXY(ByVal 点数组 As Variant, XY顺序 As String) As Variant
'根据坐标排序
'可设置单轴判断，也可设置双轴判断
'可升序，可降序
'*********************************************
'XY顺序（分号分割）：（第一位）
''''仅X——0
''''仅Y——1
''''先X后Y——2
''''先Y后X——4
'''''''''第三位（先）：
'''''''''0——降序
'''''''''1——升序
'''''''''第二位（后）：
'''''''''0——降序
'''''''''1——升序
Dim 临时点 As Variant
Dim 中转变体 As Variant
Dim 计数i As Integer
Dim 计数j As Integer
Dim 先 As Integer
Dim 后 As Integer
Dim 变体 As Variant
Dim 升降序 As Integer
Dim 标志 As Integer '设置大于还是小于
'若只比较一个方向，则
'后=-1
变体 = Split(XY顺序, ";") '分号分割
Select Case 变体(0)
Case 0
先 = 0
后 = -1
Case 1
先 = 1
后 = -1
Case 2
先 = 0
后 = 1
Case 4
先 = 1
后 = 0
End Select
'先顺序:
升降序 = 变体(1)
For 计数i = 0 To UBound(点数组)
For 计数j = 计数i + 1 To UBound(点数组)
标志 = IIf(升降序, 点数组(计数i)(先) > 点数组(计数j)(先), 点数组(计数i)(先) < 点数组(计数j)(先))
If 标志 Then '比较x坐标
中转变体 = 点数组(计数i)
点数组(计数i) = 点数组(计数j)
点数组(计数j) = 中转变体
End If
Next
Next
If 后 = -1 Then GoTo 结束
'后顺序
升降序 = 变体(2)
For 计数i = 0 To UBound(点数组)
For 计数j = 计数i + 1 To UBound(点数组)
If 点数组(计数i)(先) = 点数组(计数j)(先) Then
标志 = IIf(升降序, 点数组(计数i)(后) > 点数组(计数j)(后), 点数组(计数i)(后) < 点数组(计数j)(后))
If 标志 Then
中转变体 = 点数组(计数i)
点数组(计数i) = 点数组(计数j)
点数组(计数j) = 中转变体
End If
Else
Exit For
End If
Next
Next
结束:
orderXY = 点数组
End Function
最终，可自行修改
或直接修改函数参数，变为传递选择集
否则使用前需提取点数组
或者可以修改select
使其支持Z轴排序（个人不使用，就没加）
很好啊。可惜是VB的，要是lisp的就好了！
学习了。
mark谢谢lz 学习了，谢谢！
页:
[1]