编程，绕不开的算法----排序！处处用到，常用的排序算法也很多，如：插入排序、希尔排序、选择排序、冒泡排序、快速排序等等 ，VBA、VB6开发新手，一般都被这些排序就折腾够呛（如果你从来没用过排序，那么，你编程还没入门）。为啥单说这种开发语言呢？因为，开发，一般有Lisp,C++,vb类语言，而Lisp中有个函数vl-sort,专门用来排序的，所以说用Lisp的人是有福的，平台为你做了很多！而且 C++呢？也有类似的函数，如qsort(algorithm库中)，别人为C++开发的库！也能省不少事儿！唯独vb，没有相关的库，平台也没有内置，苦比的程序员只能自己努力了！
说了半天废话，我的目的是，也开发一个类似lisp和c++的函数，让vb coder不为排序发愁！尤其是autocad的vb开发者！
以下的代码参考自《VB真是想不到系列之三：VB指针葵花宝典之函数指针》的配套代码（原作者好像是：AdamBear），但原代码有一处小小错误，引起排序的不正确，我在以下代码中已修改！
当然还是首先上测试代码：
没有的函数或方法，到找去！
- Private Sub Command1_Click()
- 'On Error GoTo err1
- AppActivate objCad.Caption
- Dim objSset As AcadSelectionSet
- Dim objDoc As AcadDocument
- Set objDoc = ThisDrawing()
- SelectLots "MEA~PL~TMP~123", "text"
- Set objSset = objDoc.SelectionSets("MEA~PL~TMP~123")
- If objSset.Count = 0 Then Exit Sub
- Dim objArr() As AcadText, i As Long
- ReDim objArr(objSset.Count - 1)
- For i = 0 To objSset.Count - 1
- Set objArr(i) = objSset.Item(i)
- Next i
- '快速排序
- ' Call C_qsort(VarPtr(objArr(0)), UBound(objArr) + 1, 4, AddressOf CompareFunc)
- '希尔排序
- Call ShellSortAny(VarPtr(objArr(0)), UBound(objArr) + 1, 4, AddressOf CompareFunc)
- For i = 0 To UBound(objArr)
- objArr(i).TextString = objArr(i).TextString & CStr(i)
- Next i
- End Sub
测试代码的效果简单明了：对文本排序，按顺序在后面加数字！
3mnx3ol2hyx.gif
接下来是比较函数，这个函数是你排序时自定的比较回调函数，主要目的是表达对什么排序（如本例中是对text的插入点的x坐标进行排序），以什么次序排序（从大到小，还是从小到大，本例中是从小到大排列，如果对Ret变量再取负，就是从大到小了）
- '比较函数
- Function CompareFunc(Elem1 As AcadText, _
- Elem2 As AcadText, _
- unused1 As Long, _
- unused2 As Long) As Integer
- Dim Ret As Integer
- ' Debug.Print Elem1.InsertionPoint(0), Elem2.InsertionPoint(0)
- Ret = Sgn(Elem1.InsertionPoint(0) - Elem2.InsertionPoint(0))
- CompareFunc = Ret
- End Function
比较函数下载：
接下为是最关键的排序代码，一个是快速排序，一个是希尔排序，两个可以自由选择，调用代码都在上面（看注释掉的！）
这两个排序代码，是万年不用变的（如果没什么特殊情况），也就是相当于Lisp中的vl-sort函数和C++中的qsort函数。
为了光大vb版，所有附件免币！
希望看的懂回复一下！
本帖以下内容被隐藏保护；需要你回复后，才能看到！ 游客，如果您要查看本帖隐藏内容请 回复 | 
置顶卡
