CAD通过扩展记录实体向数据库读写用户自定义的全局数据(com接口VB语言)

时间:2024-01-21 18:58:56

VB代码实现如下:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
写全局数据
            Private Sub writenamedict_Click()
            Dim database As MxDrawXLib.MxDrawDatabase
            Set database = MxDrawX1.GetDatabase
            Dim nameDict  As MxDrawXLib.MxDrawDictionary
            Set nameDict = database.GetNamedObjectsDictionary
            Dim myDict  As MxDrawXLib.MxDrawDictionary
            Set myDict = nameDict.AddObject("MyDict""McDbDictionary")
            Dim xRecord As MxDrawXLib.MxDrawXRecord
            Set xRecord = myDict.AddXRecord("MyGlobalData")
            If (xRecord Is Nothing) Then
                    MsgBox "向字典中,增加扩展记录失败"
                    Exit Sub
            End If
            Dim xData2 As MxDrawXLib.MxDrawResbuf
            Set xData2 = New MxDrawXLib.MxDrawResbuf
                xData2.AddLong 99999
                xData2.AddDouble 666
                Set ptTest = New MxDrawXLib.MxDrawPoint
                ptTest.x = 77
                ptTest.y = -100
                xData2.AddPoint ptTest
                xData2.AddString "TestApp2", 1001
                xData2.AddString "张三2"
                xRecord.SetXRecordData2 xData2
                 MsgBox "写全局数据成功"
            End Sub
            取全上面写的全局数据
            Private Sub readnamedict_Click()
            Dim database As MxDrawXLib.MxDrawDatabase
            Set database = MxDrawX1.GetDatabase
            Dim nameDict  As MxDrawXLib.MxDrawDictionary
            Set nameDict = database.GetNamedObjectsDictionary
            Dim myDict As MxDrawXLib.MxDrawDictionary
            Set myDict = nameDict.GetAt("MyDict")
            If (myDict Is Nothing) Then
                    MsgBox "字典中,没有自定义数据"
                    Exit Sub
            End If
            Dim xRecord As MxDrawXLib.MxDrawXRecord
            Set xRecord = myDict.GetAt("MyGlobalData")
            If (xRecord Is Nothing) Then
                    MsgBox "向字典中,没有扩展记录"
                    Exit Sub
            End If
            Dim data As MxDrawXLib.MxDrawResbuf
            Set data = xRecord.GetXRecordData2
            data.PrintData
            End Sub