|
|
我这程序读有些图框里特定文字内容时，可以读出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 |
|
置顶卡
