Private Sub UserForm_Initialize() '根据AutoCAD的版本来确定使用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"都没有。请高手指点一下,谢谢!!! |