|
|
Private Sub UserForm_Initialize()
'根据的版本来确定使用ObjectDBX的版本
If Left(Version, 2) = "15" Then
Set objDbx = CreateObject("ObjectDBX.AxDbDocument.1")
ElseIf Left(Version, 2) = "16" Then
Set objDbx = CreateObject("ObjectDBX.AxDbDocument.16")
End If
'判断图中是否有TitleTable模块，若有则读取图块的信息；否则初始化为缺省值。
Dim objBlkref As AcadBlockReference
Dim objEnt As AcadEntity
Dim VarAttributes As Variant
Dim i As Integer
On Error Resume Next
For Each objEnt In ThisDrawing.Blocks
'取得块属性
If StrComp(objEnt.Name, "TitleTable") = 1 Then
Set objBlkref = objEnt
VarAttributes = objBlkref.GetAttributes
For i = LBound(VarAttributes) To UBound(VarAttributes)
If UCase(VarAttributes(i).TagString) = "模块代号01" Then txtbox1.Text = VarAttributes(i).TextString
If UCase(VarAttributes(i).TagString) = "模块代号02" Then txtbox2.Text = VarAttributes(i).TextString
Next i
Else
ThisDrawing.Utility.Prompt vbCr & "图中没有标题栏."
txtbox1.Text = "1"
txtbox2.Text = "2"
End If
Next objEnt
End Sub
其中,txtbox1,txtbox2是窗体上的两个txtbox控件。CAD中已经存在TitleTable属性块，但是运行该代码后，对话框窗体上这两个控件却空空如也，甚至"1","2"都没有。请高手指点一下，谢谢！！！ |
|
置顶卡
