[讨论]vba,请大家给个源码，根据一系列点的X坐标大小排序
给大家拜年啦！ 看看这个帖子，一定对你有所帮助！<A href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=15190" target="_blank" >http://bbs.mjtd.com/forum.php?mod=viewthread&tid=15190</A> ' 坐标点排序函数
' 语法：SortPoints(Points, SortMode)
' Points为坐标点数组
' SortMode为排序方式：0=X向，1=Y向，2=Z向
' 返回值为排序后的坐标点数组
Public Function SortPoints(Points As Variant, SortMode As String) As Variant
Dim NewPoints() As Variant
ReDim NewPoints(UBound(Points))
Dim k As Long
For k = 0 To UBound(NewPoints)
NewPoints(k) = Points(k)
Next k
Dim BestPoint As Variant
Dim Pnt1 As Double
Dim Pnt2 As Double
Dim i As Long
Dim j As Long
Dim Best_Value As Double
Dim Best_j As Long
For i = 0 To UBound(NewPoints) - 1
Best_Value = NewPoints(i)(SortMode)
BestPoint = NewPoints(i)
Best_j = i
For j = i + 1 To UBound(NewPoints)
If NewPoints(j)(SortMode) < Best_Value Then
Best_Value = NewPoints(j)(SortMode)
BestPoint = NewPoints(j)
Best_j = j
End If
Next j
NewPoints(Best_j) = NewPoints(i)
NewPoints(i) = BestPoint
Next i
SortPoints = NewPoints
End Function' 示例
Sub SortPointsSample()
Dim Pnts(5) As Variant
Dim i As Integer
Dim OldTxt As String
Dim NewTxt As String
OldTxt = "未排序坐标："
ThisDrawing.Utility.Prompt vbCr & "请按顺序随意点取6个坐标点" & vbCrLf
For i = 0 To 5
Pnts(i) = ThisDrawing.Utility.GetPoint(, vbCr & "点取第" & i + 1 & "点坐标点:")
OldTxt = OldTxt & vbCr & "第" & i + 1 & "点坐标为：" & Pnts(i)(0) & _
" " & Pnts(i)(1) & " " & Pnts(i)(2)
Next
Dim NewPnts As Variant
NewPnts = SortPoints(Pnts, 0)
NewTxt = "按X坐标排序的顺序："
For i = 0 To 5
NewTxt = NewTxt & vbCr & "第" & i + 1 & "点坐标为：" & NewPnts(i)(0) & _
" " & NewPnts(i)(1) & " " & NewPnts(i)(2)
Next
MsgBox OldTxt & vbCr & vbCr & NewTxt, , "明经通道VBA示例"
End Sub 我自己写过一个对点进行排序的函数，可以同时对xy坐标进行排序。Public Sub PtList(points, ByVal HAlign As Boolean, ByVal VAlign As Boolean, _
priority As Integer)
'对点集points 进行排序
'priority = 0 表示先排X坐标，priority = 1 表示先排Y坐标
'HAlign = True 表示X坐标从小到大，HAlign = False 表示X坐标从大到小
'VAlign = True 表示Y坐标从小到大，VAlign = False 表示Y坐标从大到小
Dim pt1, pt2 As Variant
Dim n As Integer
Dim A, B As Boolean
n = priority
If n = 0 Then
A = HAlign
B = VAlign
ElseIf n = 1 Then
A = VAlign
B = HAlign
End If
'主方向排序
For i = LBound(points) To UBound(points)
For j = i To UBound(points)
pt1 = points(i)
pt2 = points(j)
If pt1(n) > pt2(n) Eqv A Then
points(i) = pt2
points(j) = pt1
End If
Next j
Next i
'副方向排序
For i = LBound(points) To UBound(points)
For j = i To UBound(points)
pt1 = points(i)
pt2 = points(j)
If pt1(n) = pt2(n) Then
If pt1(1 - n) > pt2(1 - n) Eqv B Then
points(i) = pt2
points(j) = pt1
End If
End If
Next j
Next i
End Sub
页:
[1]