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

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

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

RE

本帖最后由 作者 于 2003-6-12 15:08:09 编辑

首先建立一个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

re

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

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

123

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

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

Z兄说得对,帮助文件是最好的老师

另外,关于文字的坐标及其他属性的实际应用,在本站“源码分析”区有篇文章可以参考:
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

RE

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

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

加一个getboundbox 的

楼上的给了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

re

谢谢大家,识别字搞定了,我想得太多了,我最后选了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
页: [1] 2
查看完整版本: 版主帮忙,关于在cad中找出字,并且找出字的起点,端点的坐标[求助]