月度归档： 2024 年 8 月

快速排序与冒泡排序

Sub QuickSort(List() As Double)
Dim I As Double, J As Double, K As Double, b As Double
Dim L As Double, t As Double, r As Double, d As Double
Dim p(1 To 100) As Double
Dim w(1 To 100) As Double
K = 1
p(K) = LBound(List)
w(K) = UBound(List)
L = 1
d = 1
r = UBound(List)
Do
toploop:
If r – L < 9 Then GoTo bubsort I = L J = r While J > I
comp = comp + 1
If List(I) > List(J) Then
swic = swic + 1
t = List(J)
oldx1 = List(J)
oldy1 = J
List(J) = List(I)
oldx2 = List(I)
oldy2 = I
newx1 = List(J)
newy1 = J
List(I) = t
newx2 = List(I)
newy2 = I
d = -d
End If
If d = -1 Then
J = J – 1
Else
I = I + 1
End If
Wend
J = J + 1
K = K + 1
If I – L < r – J Then p(K) = J w(K) = r r = I Else p(K) = L w(K) = I L = J End If d = -d GoTo toploop bubsort: If r – L > 0 Then
For I = L To r
b = I
For J = b + 1 To r
comp = comp + 1
If List(J) <= List(b) Then b = J Next J If I <> b Then
swic = swic + 1
t = List(b)
oldx1 = List(b)
oldy1 = b
List(b) = List(I)
oldx2 = List(I)
oldy2 = I
newx1 = List(b)
newy1 = b
List(I) = t
newx2 = List(I)
newy2 = I
End If
Next I
End If
L = p(K)
r = w(K)
K = K – 1
Loop Until K = 0
End Sub

Sub BubbleSort(List() As Double)
‘Sorts an array using bubble sort algorithm
Dim First As Double, Last As Double
Dim I As Integer, J As Integer
Dim Temp As Double

First = LBound(List)
Last = UBound(List)
For I = First To Last – 1
For J = I + 1 To Last
If List(I) > List(J) Then
Temp = List(J)
List(J) = List(I)
List(I) = Temp
End If
Next J
Next I
End Sub

批量文件命名器(BlockName)

一、功能：
1.对同一文件夹内的大批量的文件进行一次性改名；
2.对同一文件夹内的大批量的文件建立清单。
二、改名方式：
1.将所有文件名内的某种统一字符串进行替换(左栏内字符替换为右栏)，比如，有autocad.JPG和Imagecad.JPG等文件，可以一次性将其中”cad”改为”wyr”；
2.设定某字符为文件名词头，将所有文件顺序编号作为文件名字，且文件名同长(加词头对文件顺序编号)，比如，wyr000.txt、wyr001.txt、wyr002.txt等；
3.在名字开始处，用给定的字符，将所有文件名按名字最长的补齐(用以下字符补齐文件名)，比如，1.txt、67.txt、126.txt改为001.txt、067.txt、126.txt。
三、清单文件：
对于大量的文件，可以建立一个类似清单的目录文件，便于管理、检索。
四、操作步骤：
1.选择需要修改文件名的文件夹；
2.选择需要修改的文件类型；
3.选中某种改名方式；
4.输入改名规则，确认改名。
五、注意事项：
1.文件类型不可修改；
2.文件名字不可出现非法字符(软件提示)；
3.文件夹内符合条件的文件全部改名；
4.子文件夹内文件名字不会改动；
5.顺序编号改名时，按原文件排名次序进行；
6.目标文件夹内自动生成日记文件BlockName.log，记录改名历史；
7.改名不可恢复。

下载见软件下载。

万里茶路

　　《山西历史地图集》“清代晋商商路”记述：“大致在乾隆30年（1765）起，在山西商人的推动下，逐渐形成了一条以山西、河北为枢纽，北越长城，贯穿蒙古，经西伯利亚，通往欧州腹地的陆上国际茶叶商路。在南方，又开辟了由福建崇安过分水关，入江西铅山县，顺信江下鄱阳湖,穿湖而出九江口入长江,溯江抵武昌, 转汉水至襄樊，贯河南入泽州，经潞安抵平遥，祁县，太谷，忻州，大同，天镇到张家口，贯穿蒙古草原到库伦至恰克图，这是一条重要的茶叶商路。”

　　“茶叶之路”是一条纵贯南北水陆交替的商业运输线路。起点在福建崇安（现武夷山市），途经江西、湖北、河南、山西、直隶（河北）、内蒙古，终点是乌里雅苏台（现蒙古人民共和国）的恰克图。全程约九千二百余里（四千六百公里），亦称“万里茶路”。

　　“茶叶之路”具体运行线路如下：

　　自福建建宁府崇安县下梅村，顺梅溪，西入崇阳溪，北上，达崇安城。此段为篷船水运；

　　于崇安城装鸡公车，沿闽赣古驿道西北行，过闽赣交界之分水关，达信江南岸之江西广信府铅山河口镇；

　　于河口装大船，顺信江西行，经广信府弋阳，贵溪，鹰潭，饶州府安仁（余江），余干，入鄱阳湖；西北，经南康府都昌，星子，达长江南岸之九江府湖口县湖口镇；

　　溯长江西行，经九江府德化（九江），瑞昌，湖北黄州府广济（武穴），蕲州（蕲春），蕲水（浠水），黄冈，武昌府兴国洲（阳新），大冶，武昌（鄂州），江夏（武汉武昌），抵汉阳府汉阳县汉口镇；

　　逆汉水西行，经汉阳府蔡甸，汉川，沔阳，安陆府天门，潜江，钟祥，荆门沙洋，襄阳府宜城，达襄阳汉江北岸之樊城；

　　换小船，西北入唐白河，上至两河口，入唐河，经河南南阳府唐县，达水路终点南阳府裕州赊旗店（社旗）；

　　从赊旗店上岸，转陆路，用骡、马驮运北行，经裕州方城，叶县，汝州宝丰，汝州，河南府登封，偃师，达黄河南岸之孟津渡口；

　　渡黄河，经怀庆府孟县，河内（沁阳），沿太行山太行陉，过碗子城，至山西泽州府凤台县（晋城）；北行，经泽州府高平，潞安府长子，屯留，襄垣，沁州，武乡，太原府祁县，徐沟，太原县，阳曲县，忻州，代州崞县（原平），北出雁门关，经大同府山阴，怀仁，大同镇，东行，大同县，阳高，天镇，直隶宣化府怀安，万全左卫，达张家口；

　　从张家口，用骆驼或“老倌车”，北至野狐岭上坝，经口北三厅兴和城（张北），明爱（内蒙古商都），内蒙古察哈尔，狮子王旗，沿阿尔泰军台，经乌里雅苏台土谢图汗部左翼中旗赛尔乌苏，左翼右末旗，达中旗之库伦（蒙古人民共和国乌兰巴托）；

　　又北行，经右翼右末旗，右翼左末旗，终达中俄边境之恰克图。

AutoCAD 的多段线(Polyline)

‘绑定 AutoCAD
Dim I As Integer, J As Integer
Dim oAutoCAD As Object
Call BindAutoCAD(True)

‘打开并绑定文件 D:/Test.dwg
Dim oDraw As Object ‘AutoCAD 多文档之一
Set oDraw = oAutoCAD.Application.Documents.Open(“D:/Test.dwg”)

ReDim oPolyline As Object
Dim dVertices(0 To 14) As Double ‘五个点,四段线
‘Define the 2D polyline points
dVertices(0) = 121
dVertices(1) = 234
dVertices(2) = 0
dVertices(3) = 345
dVertices(4) = 45
dVertices(5) = 0
dVertices(6) = 546
dVertices(7) = 67
dVertices(8) = 0
dVertices(9) = 78
dVertices(10) = 89
dVertices(11) = 0
dVertices(12) = 222
dVertices(13) = 444
dVertices(14) = 0
‘Create a lightweight Polyline object in model space
Set oPolyline = oDraw.ModelSpace.AddPolyline(dVertices)
‘设置每段的宽度
For J = 0 To 3
oPolyline .SetWidth J, 2, 3 ‘第 J 段, 起点宽度 2, 终点宽度 3
Next J
oPolyline .Color = 7 ‘acWhite
oPolyline .Update