选择集内的排序问题(高手都来比试一下)
现假设有选择集Sset，其中全为单行文字，由于过滤选择的时候是系统按照其绘图先后顺序而自动添加的，现如何通过其个单行文字的插入点坐标按从从左到右，自上而下的重新排序。此功能用为快速修改页码或图号等，比如一文件中有100幅图，可先查找“第*页”的文字将其添加到Sset中，然后自动修改页码。请有兴趣的朋友及高手都来出个主意，怎么样给选择集内的元素排序。
Dim currInsertionPoint As Variant
currInsertionPoint = textObj.insertionPoint
只是比较insertionPoint（０）和insertionPoint（１）的大小问题啊。
我的办法是autocad到EXCEL-SQL排序.
你考虑问题太简单了，insertionPoint（０）和insertionPoint（１）排序问题可是一个专题了。
排序，X轴排序，y轴排序。二维数组排序。
利用二维数组的已经是很简单的了，当然你如果只是对文字来排序的话，就可以用这种方法，比大小，自己想想就明白了。我做了一些排序的东西，是针对图框排序的，也是通过点来比较的，但是还不够好，不知道其他人还有什么更好的办法。 看看我这样写对不？
模块：复制代码代码
Sub RandApt()
'随机布点x=0~1000,y=0~1000
Dim pt As AcadPoint
Dim p() As Double
Dim pl As AcadLWPolyline
Dim i As Integer
ReDim p(7)
p(0) = 0: p(1) = 0
p(2) = 1000: p(3) = 0
p(4) = 1000: p(5) = 1000
p(6) = 0: p(7) = 1000
Set pl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p)
pl.Closed = True
ThisDrawing.Application.ZoomExtents
ReDim p(2)
For i = 0 To 1000
p(0) = Rnd * 1000
p(1) = Rnd * 1000
Set pt = ThisDrawing.ModelSpace.AddPoint(p)
Next i
End Sub
Sub Sort()
Dim pt As AcadPoint
Dim Ent As AcadEntity
Dim dt() As Point3d
Dim i As Integer
i = -1
For Each Ent In ThisDrawing.ModelSpace
If Ent.ObjectName = "AcDbPoint" Then
Set pt = Ent
i = i + 1
ReDim Preserve dt(i)
dt(i).x = Format(pt.Coordinates(0), "0")
dt(i).y = Format(pt.Coordinates(1), "0.00")
dt(i).z = Format(pt.Coordinates(2), "0.000")
End If
Next
'排序Xy
SSort dt, 2
Open "c:\tmp.txt" For Output As #1
For i = 0 To UBound(dt)
Print #1, dt(i).x, dt(i).y, dt(i).z
Next i
Close #1
Shell "notepad.exe c:\tmp.txt", vbNormalFocus
MsgBox "Over"
End Sub
Function SSort(dt() As Point3d, k As Integer)
'X=1、xy=2、xyz=3
Dim dt1() As Point3d
Dim i As Integer
Dim Ex As Boolean
i = UBound(dt)
ReDim dt1(i)
Dim N As Integer
N = i
dt1(0) = dt(0)
If k >= 1 Then '一次排序
For i = 1 To N
Ex = False
For j = 0 To i - 1
If dt(i).x = 2 Then '二次排序
Dim tmp As Point3d
x1 = 0: x2 = 0
While x10 Then
For k = x1 To x2
For j = x1 To x2 - k + x1 - 1
If dt1(j).y > dt1(j + 1).y Then
tmp = dt1(j + 1)
dt1(j + 1) = dt1(j)
dt1(j) = tmp
End If
Next j
Next k
End If
x1 = i
x2 = x1
Wend
End If
'==============='===============
If k >= 3 Then '三次排序
x1 = 0: x2 = 0
While x10 Then
For k = x1 To x2
For j = x1 To x2 - k + x1 - 1
If dt1(j + 1).y 以上方法在处理AutoCAD的材料表处理中比较实用。
页:
[1]