社区 › VB › 取dwg 文字信息

tonyhuangg 发表于 2004-10-20 16:19:00

取dwg 文字信息

我这程序读有些图框里特定文字内容时，可以读出tagstring，但tagstring上的文字内容总读为空（textstring），帮忙看看，提取的属性对吗（vb6.0，用object库2004）
       
       
Dim acadapp As AcadApplication
Dim acaddoc As AcadDocument
'初始化CAD
On Error Resume Next
Set acadapp = GetObject(, ".application.16")
If Err Then
               Err.Clear
               Set acadapp = CreateObject("autocad.application.16")
               If Err Then
                               MsgBox Err.Description
                               Exit Sub
               End If
End If
cd1.DefaultExt = ".dwg"
cd1.Filter = "dwg dwg(*.dwg)"
cd1.ShowOpen
Dim getfilepath As String
getfilepath = Trim(cd1.FileName)
acadapp.Documents.Open (getfilepath)
Set acaddoc = acadapp.ActiveDocument
acadapp.Visible = False
Dim s As String
Dim i, j, k As Integer
Dim blk As AcadBlock
i = acaddoc.Blocks.Count
       
For k = 1 To i
               s = acaddoc.Blocks.Item(k - 1).Name
               s = UCase(Trim(s))
               MsgBox (s)
               If s = "TBZ00" Then
                                               Set blk = acaddoc.Blocks.Item(k - 1)
                                       Exit For
               Else
                                       s = ""
               End If
Next
MsgBox (s)
s = ""
Dim tag, prompt, value As String
        For i = 0 To blk.Count - 1
                                                       Dim obj As AcadObject
                                                       Set obj = blk.Item(i)
                                                       s = obj.ObjectName
                                                       If s = "AcDbAttributeDefinition" Then
                                                                                       Dim attrObj As AcadAttribute
                                                                                       Set attrObj = obj
                                                                                       tag = ""
                                                                                       tag = attrObj.TagString
                                                                                       If UCase(tag) = "STAGE" Then
                                                                                                                               prompt = attrObj.PromptString
                                                                                                                               value = attrObj.TextString
                                                                                                                               MsgBox (value)
                                                                                                                               MsgBox "Tag: " & tag & vbCr & "Value: " & value & vbCr & "Value: " & value & vbCr
                                                                                                                               Exit For
                                                                                       End If
                                                       
                                                       End If
       Next
       
        rtb1.Text = ""
       
        rtb1.Text = value
                                                               
       
       
       
       
acaddoc.Close
'acadapp.Quit

雪山飞狐_lzh 发表于 2004-10-20 20:48:00

你应该处理BlockRef对象而不是Block对象

aaa000999 发表于 2004-11-20 21:07:00

挺好的

cad-dragon 发表于 2004-11-27 22:09:00

2搂说得对！

查看完整版本: 取dwg 文字信息