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

hawk151 · 发表于 2003-6-12 09:18:00

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 · 发表于 2003-6-12 15:08:00

首先建立一个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 · 发表于 2003-6-12 10:31:00

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

zzlzz · 发表于 2003-6-12 10:46:00

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

leeyeafu · 发表于 2003-6-12 11:04:00

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

hawk151 · 发表于 2003-6-12 12:02:00

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

thankyou · 发表于 2003-6-12 15:06:00

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

zzlzz · 发表于 2003-6-12 16:30:00

楼上的给了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 · 发表于 2003-6-13 14:43:00

谢谢大家，识别字搞定了，我想得太多了，我最后选了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 · 发表于 2003-6-13 14:49:00

大家给看看，我这段程序呢目的是要把字识别出来，然后分别按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

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

发表回复

精选推荐