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

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