乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 41|回复: 2

[讨论]vba,请大家给个源码,根据一系列点的X坐标大小排序

[复制链接]

6

主题

10

帖子

1

银币

初来乍到

Rank: 1

铜币
34
发表于 2004-2-2 22:48:00 | 显示全部楼层 |阅读模式
给大家拜年啦!
回复

使用道具 举报

26

主题

243

帖子

9

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
347
发表于 2004-2-2 23:01:00 | 显示全部楼层
看看这个帖子,一定对你有所帮助!
回复

使用道具 举报

158

主题

2315

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2951
发表于 2004-2-3 12:59:00 | 显示全部楼层
  1. ' 坐标点排序函数
  2. ' 语法:SortPoints(Points, SortMode)
  3. ' Points为坐标点数组
  4. ' SortMode为排序方式:0=X向,1=Y向,2=Z向
  5. ' 返回值为排序后的坐标点数组
  6. Public Function SortPoints(Points As Variant, SortMode As String) As Variant
  7.        Dim NewPoints() As Variant
  8.        ReDim NewPoints(UBound(Points))
  9.        Dim k As Long
  10.        For k = 0 To UBound(NewPoints)
  11.                NewPoints(k) = Points(k)
  12.        Next k
  13.       
  14.        Dim BestPoint As Variant
  15.        Dim Pnt1 As Double
  16.        Dim Pnt2 As Double
  17.        Dim i As Long
  18.        Dim j As Long
  19.        Dim Best_Value As Double
  20.        Dim Best_j As Long
  21.        For i = 0 To UBound(NewPoints) - 1
  22.                Best_Value = NewPoints(i)(SortMode)
  23.                BestPoint = NewPoints(i)
  24.                Best_j = i
  25.                For j = i + 1 To UBound(NewPoints)
  26.                        If NewPoints(j)(SortMode)  pt2(n) Eqv A Then
  27.                points(i) = pt2
  28.                points(j) = pt1
  29.            End If
  30.        Next j
  31.    Next i
  32.    '副方向排序
  33.    For i = LBound(points) To UBound(points)
  34.        For j = i To UBound(points)
  35.            pt1 = points(i)
  36.            pt2 = points(j)
  37.          If pt1(n) = pt2(n) Then
  38.            If pt1(1 - n) > pt2(1 - n) Eqv B Then
  39.                points(i) = pt2
  40.                points(j) = pt1
  41.            End If
  42.          End If
  43.        Next j
  44.    Next i
  45.    
  46. End Sub
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-15 10:46 , Processed in 0.778014 second(s), 69 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表