作者： 老王

批量文档整理器(TrimText)

一、功能：
对同一文件夹内的大批量文本文件的内容进行规律性整理。
二、整理方式：
1.如果一个或多个文本文件内某一行或几行的内容均是同一文字串，可以将这样的行进行同一替换(整行替换)；
2.如果一个或多个文本文件内某一行或几行的开头均是同一文字串，可以将这样的行进行同一替换(整行替换)；
3.如果一个或多个文本文件内某一行或几行的结尾均是同一文字串，可以将这样的行进行同一替换(整行替换)；
4.可以将本是一段但被强制分段的相邻几段恢复为一段(断行续接)；
5.”断行续接”时可以指定以某些文字开头的段为完整段(即不与其他段合并，保持独立)，这些文字输入支持统配符”?”；也可以选择是否”以序数词开头视为整段”；
6.可以将一段文字根据给定长度分为几段(等长分段)；
7.维持原段落设置(不调段落)；
8.可以在每一段的开始增加文字(段首增加文字)；
9.可以在每一段的结尾增加文字(段尾增加文字)；
10.可以在每一段的开始取消文字(段首取消文字)；
11.可以在每一段的结尾取消文字(段尾取消文字)；
12.可以将文本文件内的空行删除(删除空行)；
13.可以在每两段之间设一空行(段间设行)；
14.维持原空行设置(不调空行)；
15.可以在所有文件内进行统一的文字替换(文字替换)。
三、操作步骤：
1.选择需要整理文件的文件夹；
2.检查文件列表；
3.输入替换内容；
4.选择是否设置段间空行；
5.选择是否删除空行；
6.选择是否进行首尾处理；
7.选择是否等长分段，并输入每段的自数；
8.选择是否断行续接，这时可以给出以某些文字开头的段为完整段的标识文字，也可以选择是否以序数词开头的段为完整段；
9.确认整理。
四、注意事项：
1.文件夹内符合条件的文件全部被整理；
2.子文件夹内文件不会改动；
3.三种替换方式的每一种内都提供了多个替换机会，左为空时对应行替换不会执行；
4.”断行续接”中”以??????开头视为整段”提供了多个标识文字，有几个执行几个，其余不符合标识文字的段落照常执行”断行续接”；
5.”断行续接”中的标识文字执行效果举例如下：如键入”第???回”为完整段标识文字，如文件内有”第一二零回 甄士隐详说太虚情 贾雨村归结红楼梦”作为独立段存在，不与上下段作接续合并；
6.”断行续接”中”以序数词开头视为整段”，即是以”1234567890一二三四五六七八九十零”中之一开头的段作为完整段对待；
7.”断行续接”可以将大多数的符合条件段合并；
8.段落首尾增加或取消文字是对原行的操作，比如，”abc 东方之星”同时执行段首增加文字”abc “和段首取消文字”abc “，最终效果为”abc 东方之星”，只是现在的”abc “是新增加的，原来的”abc “已被取消掉；
9.硬回车即视为一段；
10.替换时区分大小写；
11.整理不可恢复。

下载见软件下载。

快速排序与冒泡排序

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.改名不可恢复。

下载见软件下载。

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