版主帮忙，关于在cad中找出字，并且找出字的起点，端点的坐标[求助]

hawk151

Dim textobj As AcadEntity
Dim point1 As Variant
Dim point2 As Variant
For Each textobj In ThisDrawing.ModelSpace '找字
     If textobj.ObjectName = "AcaDtext" Then
            
            point1 = textobj.StartPoint
            point2 = textobj.EndPoint
版主，我是个新手，很多东西都不懂，上面的这段，我的目的是想找出说有的字，然后比所有的字的插入点坐标找到，但是对于插入点，以及字的属性，搞不懂，因此找不到，还请版主帮忙给指点一下。

thankyou

首先建立一个AcadTextSet的选择集：
Dim AcadTextSet As AcadSelectionSet
Dim TextObj As AcadText
Dim Point1,Point2 As Variant
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant

Set AcadTextSet= ThisDrawing.SelectionSets.Add("ACADTEXT
")
FilterType(0)=0：FilterData(0)="TEXT"
AcadTextSet.Select acSelectionSetAll, , , FilterType, FilterData
For Each TextObj In AcadTextSet
'Point1 = TextObj.StartPoint
'Point2 = TextObj.EndPoint
Point1= TextObj.InsertionPoint
'...
Next

hawk151

楼上的，你的程序我有点看不懂，并且我运行的时候，怎么有错误，还请指教。

zzlzz

楼主说的是文字的坐标？
单行文字有insertposition属性（看看帮助文件核对一下），但似乎不好直接使用，因为还不知道文字对齐方式。
用getboundingbox 比较方便，具体的在help文件里很详细。
关于对象属性，仍然推荐帮助文件，呵呵。那里是最及时最详细的老师。

leeyeafu

另外，关于文字的坐标及其他属性的实际应用，在本站“源码分析”区有篇文章可以参考：
http://www.mjtd.com/bbs/dispbbs.asp?BoardID=16&RootID=21361&ID=21420&skin=1

hawk151

各位给我写的那一段，指点一下吧，应该怎么改，呵呵，我要学得太多了

thankyou

Point1 = TextObj.StartPoint
Point2 = TextObj.EndPoint
改为：TEXT无StartPoint 和EndPoint属性
TextObj.InsertionPoint

zzlzz

楼上的给了InsertionPoint的说法，再贴一个getboundbox 的，基本就是文字起点端点的意思。大致如下：

Sub Example_GetBoundingBox()
     
    Dim minExt As Variant
    Dim maxExt As Variant
   
    ' Return the bounding box for the text and return the minimum
    ' and maximum extents of the box in the minExt and maxExt variables.
    TextObj.GetBoundingBox minExt, maxExt
   
    ' Print the min and max extents
    MsgBox "The extents of the bounding box for the text are:" & vbCrLf _
         & "Min Extent: " & minExt(0) & "," & minExt(1) & "," & minExt(2) _
         & vbCrLf & "Max Extent: " & maxExt(0) & "," & maxExt(1) & "," & maxExt(2), vbInformation, "GetBoundingBox Example"
         
End Sub

hawk151

谢谢大家，识别字搞定了，我想得太多了，我最后选了insertposition属性
因为我考虑多了，我要把字排序，用不到端点坐标，这样的话，就简单了。
Dim textobj As AcadEntity
Dim point1 As Variant
Dim point2 As Variant
For Each textobj In ThisDrawing.ModelSpace '找字
     If textobj.ObjectName = "AcDbText" Then
            
            point1 = textobj.insertposition
   。。。。。。。
      End If
Next
这样就行了

hawk151

大家给看看，我这段程序呢目的是要把字识别出来，然后分别按y,x排序，但是举个例子，比如我识别出268个字也就是268个坐标，但是在排序的时候，按x排会出现568个坐标，按y排会有789个坐标。请大家研究一下，小弟刚上手没多久，多多帮忙



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