|
|
发表于 2007-11-22 10:51:00
|
显示全部楼层
看看我这样写对不？
模块：复制代码代码
[code]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 x1 0 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 x1 0 Then
For k = x1 To x2
For j = x1 To x2 - k + x1 - 1
If dt1(j + 1).y 以上方法在处理AutoCAD的材料表处理中比较实用。 |
|
置顶卡
