乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 52|回复: 3

取dwg 文字信息

[复制链接]

6

主题

8

帖子

1

银币

初来乍到

Rank: 1

铜币
32
发表于 2004-10-20 16:19:00 | 显示全部楼层 |阅读模式
我这程序读有些图框里特定文字内容时,可以读出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
回复

使用道具 举报

72

主题

2726

帖子

9

银币

社区元老

Rank: 75Rank: 75Rank: 75

铜币
3014
发表于 2004-10-20 20:48:00 | 显示全部楼层
你应该处理BlockRef对象而不是Block对象
回复

使用道具 举报

0

主题

1

帖子

1

银币

初来乍到

Rank: 1

铜币
1
发表于 2004-11-20 21:07:00 | 显示全部楼层
挺好的
回复

使用道具 举报

0

主题

3

帖子

3

银币

初来乍到

Rank: 1

铜币
3
发表于 2004-11-27 22:09:00 | 显示全部楼层
2搂说得对!
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-16 13:54 , Processed in 0.319043 second(s), 60 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表