这是我的一小段程序，有漏洞运算不准确，请大家改改[讨论]

hawk151

大家给看看，我这段程序呢目的是要把字识别出来，然后分别按y,x排序，但是举个例子，比如我识别出268个字也就是268个坐标，但是在排序的时候，按x排会出现568个坐标，按y排会有789个坐标。请大家研究一下，小弟刚上手没多久，多多帮忙
我上传了一个表 我用下面的程序运算 206个字  然后排序 就有3284  958 个坐标拉！
赫赫，我找不出问题呀，大家看看



Option Explicit
Private Sub CommandButton1_Click()
Dim totalczx As Integer
Dim czx, spx As Integer
Dim textobj As AcadEntity
Dim point1 As Variant
Dim point2 As Variant
Dim a(1 To 10000) As Double
Dim b(1 To 10000) As Double
Dim i, j As Integer
i = 1
j = 1
czx = 0

Open "e:\1.txt" For Output As #1 '

For Each textobj In ThisDrawing.ModelSpace '找字
     If textobj.ObjectName = "AcDbText" Then
            
            point1 = textobj.InsertionPoint
           
            
            a(i) = point1(0)
            
            b(j) = point1(1)
            
        
            i = i + 1
            j = j + 1
            czx = czx + 1
            Write #1, czx, point1(0), point1(1), point1(2)
                    
            
           
     End If
Next
totalczx = czx

Close #1





'############################首先按x坐标排序####################################333


Dim im As Integer
Dim t As Double
Dim n As Integer
n = totalczx
For i = 1 To n - 1 '排序
  im = i
  For j = i + 1 To n
       If a(j) < a(im) Then im = j
  Next j
  t = a(i)
  a(i) = a(im)
  a(im) = t
Next i

For i = 1 To czx

Next i
Close #2

czx = 0


Open "e:\字的排序按x坐标.txt" For Output As #3
For i = 1 To totalczx
For Each textobj In ThisDrawing.ModelSpace
     If textobj.ObjectName = "AcDbText" Then
            
            point1 = textobj.InsertionPoint
           
            
            
               
               If a(i) = point1(0) Then
               
                czx = czx + 1
            Write #3, czx, point1(0), point1(1), point1(2)
                    
              End If
           End If
     
Next
Next i
Close #3
'######################然后按y坐标排序########################333


n = totalczx '假设水平线的数目为100
For i = 1 To n - 1 '排序
  im = i
  For j = i + 1 To n
       If b(j) < b(im) Then im = j
  Next j
  t = b(i)
  b(i) = b(im)
  b(im) = t
Next i

For i = 1 To czx

Next i
Close #6


czx = 0
Open "e:\字的排序按y坐标排序.txt" For Output As #4
For i = 1 To totalczx

For Each textobj In ThisDrawing.ModelSpace
     If textobj.ObjectName = "AcDbText" Then
            
            point1 = textobj.InsertionPoint
           
            
        
               If b(i) = point1(1) Then
                 czx = czx + 1
            Write #4, czx, point1(0), point1(1), point1(2)
                     
            End If
     End If
  
Next
Next i
Close #4

End Sub

hawk151

大家帮忙拉

zzlzz

但实在是看不大明白 能不能写的简单清楚些

hawk151

好的，我写的详细些

efan2000

声明一个Dim a(1 To 10000,0 to 2) As Double用于保存所有文本的插入点坐标,之后就省去了每次都要查找模型空间中的文字这一段操作,进行排序时可以复制一份进行操作.
关于记录重复,应该是在程序当中输出时重复了检查一下.

zzlzz

重复的原因应该如上。
efan斑竹的说的很有道理。建议定义二维数组或者建立选择集－－复制选择集－－对其中文字对象直接排序－－一次性输出。
如果对象不是太多，对选择集中对象排序不会要很多时间，而程序会清楚很多，省去反复的循环。

hawk151

这几天没上来看，真是可惜了，我试着改改，若是我改不了，还请大家帮忙。
版主：这个重复检查了一下，到底详细上怎么说

hawk151

Option Explicit
Private Sub CommandButton1_Click()
Dim totalczx As Integer
Dim czx, spx As Integer
Dim textobj As AcadEntity
Dim point1 As Variant
Dim point2 As Variant
Dim a(1 To 10000, 0 To 2) As Double
Dim b(1 To 10000, 0 To 2) As Double
Dim i, j As Integer
i = 1
j = 1
czx = 0

Open "e:\1.txt" For Output As #1 '

For Each textobj In ThisDrawing.ModelSpace '找字
     If textobj.ObjectName = "AcDbText" Then
            
            point1 = textobj.InsertionPoint
           
            
            a(i, 0) = point1(0)
            a(i, 1) = point1(1)
            b(i, 0) = point1(0)
            b(i, 1) = point1(1)
        
            i = i + 1
            j = j + 1
            czx = czx + 1
            Write #1, czx, point1(0), point1(1), point1(2)
                    
            
           
     End If
Next
totalczx = czx

Close #1
'############################首先按x坐标排序####################################333


Dim im As Integer
Dim t As Variant
Dim n As Integer
n = totalczx
For i = 1 To n - 1 '排序
  im = i
  For j = i + 1 To n
       If a(j, 0) < a(im, 0) Then im = j
  Next j
  t = a(i, 0)
  a(i, 0) = a(im, 0)
  a(im, 0) = t
Next i

For i = 1 To czx

Next i


czx = 0


Open "e:\字的排序按x坐标.txt" For Output As #3
For i = 1 To totalczx

           
            
            
               
              
               
                czx = czx + 1
            Write #3, czx, a(i, 0), a(i, 1), a(i, 2)
                    Next i
Close #3
'######################然后按y坐标排序########################333


n = totalczx '假设水平线的数目为100
For i = 1 To n - 1 '排序
  im = i
  For j = i + 1 To n
       If b(j, 1) < b(im, 1) Then im = j
  Next j
  t = b(i, 1)
b(i, 1) = b(im, 1)
  b(im, 1) = t
Next i

For i = 1 To czx

Next i



czx = 0
Open "e:\字的排序按y坐标排序.txt" For Output As #4
For i = 1 To totalczx


                 czx = czx + 1
            Write #4, czx, b(i, 0), b(i, 1), b(i, 2)
                     
           
     
  

Next i
Close #4

End Sub

hawk151

上述的程序，运算结果1372个点，应该对了，呵呵，谢谢版主，z兄