发个关于排序的帖子吧

zzyong00

     编程，绕不开的算法----排序！处处用到，常用的排序算法也很多，如：插入排序、希尔排序、选择排序、冒泡排序、快速排序等等 ，VBA、VB6开发新手，一般都被这些排序就折腾够呛（如果你从来没用过排序，那么，你编程还没入门）。为啥单说这种开发语言呢？因为，AutoCAD开发，一般有Lisp,C++,vb类语言，而Lisp中有个函数vl-sort,专门用来排序的，所以说用Lisp的人是有福的，平台为你做了很多！而且 C++呢？也有类似的函数，如qsort(algorithm库中)，别人为C++开发的库！也能省不少事儿！唯独vb，没有相关的库，平台也没有内置，苦比的程序员只能自己努力了！
    说了半天废话，我的目的是，也开发一个类似lisp和c++的函数，让vb coder不为排序发愁！尤其是autocad的vb开发者！
以下的代码参考自《VB真是想不到系列之三：VB指针葵花宝典之函数指针》的配套代码（原作者好像是：AdamBear），但原代码有一处小小错误，引起排序的不正确，我在以下代码中已修改！
当然还是首先上测试代码：
没有的函数或方法，到http://bbs.mjtd.com/thread-111783-1-1.html找去！

1. Private Sub Command1_Click()
   
2.     'On Error GoTo err1
   
3.     AppActivate objCad.Caption
   
4. 
   
5.     Dim objSset As AcadSelectionSet
   
6.     Dim objDoc As AcadDocument
   
7.     Set objDoc = ThisDrawing()
   
8.     SelectLots "MEA~PL~TMP~123", "text"
   
9.     Set objSset = objDoc.SelectionSets("MEA~PL~TMP~123")
   
10.     If objSset.Count = 0 Then Exit Sub
    
11.     Dim objArr() As AcadText, i As Long
    
12.     ReDim objArr(objSset.Count - 1)
    
13.     For i = 0 To objSset.Count - 1
    
14.         Set objArr(i) = objSset.Item(i)
    
15.     Next i
    
16.     '快速排序
    
17.    ' Call C_qsort(VarPtr(objArr(0)), UBound(objArr) + 1, 4, AddressOf CompareFunc)
    
18.    '希尔排序
    
19.     Call ShellSortAny(VarPtr(objArr(0)), UBound(objArr) + 1, 4, AddressOf CompareFunc)
    
20.     For i = 0 To UBound(objArr)
    
21.         objArr(i).TextString = objArr(i).TextString & CStr(i)
    
22.     Next i
    
23. End Sub
    

Private Sub Command1_Click()<br />     'On Error GoTo err1<br />     AppActivate objCad.Caption<br /> <br />     Dim objSset As AcadSelectionSet<br />     Dim objDoc As AcadDocument<br />     Set objDoc = ThisDrawing()<br />     SelectLots "MEA~PL~TMP~123", "text"<br />     Set objSset = objDoc.SelectionSets("MEA~PL~TMP~123")<br />     If objSset.Count = 0 Then Exit Sub<br />     Dim objArr() As AcadText, i As Long<br />     ReDim objArr(objSset.Count - 1)<br />     For i = 0 To objSset.Count - 1<br />         Set objArr(i) = objSset.Item(i)<br />     Next i<br />     '快速排序<br />    ' Call C_qsort(VarPtr(objArr(0)), UBound(objArr) + 1, 4, AddressOf CompareFunc)<br />    '希尔排序<br />     Call ShellSortAny(VarPtr(objArr(0)), UBound(objArr) + 1, 4, AddressOf CompareFunc)<br />     For i = 0 To UBound(objArr)<br />         objArr(i).TextString = objArr(i).TextString & CStr(i)<br />     Next i<br /> End Sub<br />

测试代码的效果简单明了：对文本排序，按顺序在后面加数字！
接下来是比较函数，这个函数是你排序时自定的比较回调函数，主要目的是表达对什么排序（如本例中是对text的插入点的x坐标进行排序），以什么次序排序（从大到小，还是从小到大，本例中是从小到大排列，如果对Ret变量再取负，就是从大到小了）

1. '比较函数
   
2. Function CompareFunc(Elem1 As AcadText, _
   
3.     Elem2 As AcadText, _
   
4.     unused1 As Long, _
   
5.     unused2 As Long) As Integer
   
6.     Dim Ret As Integer
   
7. 
   
8. '    Debug.Print Elem1.InsertionPoint(0), Elem2.InsertionPoint(0)
   
9.     Ret = Sgn(Elem1.InsertionPoint(0) - Elem2.InsertionPoint(0))
   
10.     CompareFunc = Ret
    
11. End Function
    

'比较函数<br /> Function CompareFunc(Elem1 As AcadText, _<br />     Elem2 As AcadText, _<br />     unused1 As Long, _<br />     unused2 As Long) As Integer<br />     Dim Ret As Integer<br /> <br /> '    Debug.Print Elem1.InsertionPoint(0), Elem2.InsertionPoint(0)<br />     Ret = Sgn(Elem1.InsertionPoint(0) - Elem2.InsertionPoint(0))<br />     CompareFunc = Ret<br /> End Function<br />

比较函数下载：

接下为是最关键的排序代码，一个是快速排序，一个是希尔排序，两个可以自由选择，调用代码都在上面（看注释掉的！）
这两个排序代码，是万年不用变的（如果没什么特殊情况），也就是相当于Lisp中的vl-sort函数和C++中的qsort函数。

为了光大vb版，所有附件免币！

希望看的懂回复一下！

wwswwswws

排序算法是很重要的，这段时间正在研究各种排序如：快速排序、希尔排序、堆排序、插入排序、冒泡排序、选择排序、基数排序、归并排序。
不错，支持楼主。

zzyong00

wwswwswws 发表于 2015-2-12 15:26
排序算法是很重要的，这段时间正在研究各种排序如：快速排序、希尔排序、堆排序、插入排序、冒泡排序、选择 ...

实际上，这么算法都是成型的，而每个程序员都重新学一遍，的确没太大意义，完全可以用现成的，一劳永逸的，现在.net也已经自带排序功能了

tester005

哦  我直接搞了书上例子的源代码
CAD实体排序要有容差才行

tangxjcxv65

学习了呵呵，