如何將一個變量放入autocad中,關閉autocad後，下次打開時這個變量還存在

yuangw1234

如何将一个变量放入AutoCAD中,关闭autocad后，下次打开时这个变量还存在cad中,这好象要用在词典，请问一下是不是先增加一个词典，然后再用setxdata,再用getxdata,有没有哪位在师可以贴个类子上来

雪山飞狐_lzh

字典和Xdata是两回事,下面的函数是向字典读写的

2. Public Function SetXRecord(ByVal DictName As String, ByVal Keyword As String, ByVal XRecordData)
3.     Dim pDict As AcadDictionary
4.     Dim pXRecord As AcadXRecord
5.     Dim XRecordType() As Integer
6.     Dim pLen As Integer
7.    
8.     Set pDict = ThisDrawing.Dictionaries.Add(DictName)
9.     Set pXRecord = pDict.AddXRecord(Keyword)
10.    
11.     pLen = UBound(XRecordData)
12.     ReDim XRecordType(pLen) As Integer
13.     For i = 0 To pLen
14.         Select Case VarType(XRecordData(i))
15.             Case vbInteger, vbLong
16.                 XRecordType(i) = 70
17.             Case vbSingle, vbDouble
18.                 XRecordType(i) = 40
19.             Case vbString
20.                 XRecordType(i) = 1
21.         End Select
22.     Next i
23.    
24.     pXRecord.SetXRecordData XRecordType, XRecordData
25. End Function
26. Public Function GetXRecord(ByVal DictName As String, ByVal Keyword As String)
27. On Error GoTo ErrHandle
28.     Dim pDict As AcadDictionary
29.     Dim pXRecord As AcadXRecord
30.     Dim xt
31.     Set pDict = ThisDrawing.Dictionaries(DictName)
32.     Set pXRecord = pDict.GetObject(Keyword)
33.     pXRecord.GetXRecordData xt, GetXRecord
34.     Exit Function
35. ErrHandle:
36.     GetXRecord = Null
37. End Function
39. Public Function CreateArray(ByVal TypeName As VbVarType, ParamArray ValArray())
40.     Dim nCount As Integer
41.     Dim i
42.     Dim mArray
43.    
44.     nCount = UBound(ValArray)
45.    
46.     Select Case TypeName
47.     Case vbDouble
48.         Dim dArray() As Double
49.         ReDim dArray(nCount)
50.         For i = 0 To nCount
51.             dArray(i) = ValArray(i)
52.         Next i
53.         CreateArray = dArray
54.     Case vbInteger
55.         Dim nArray() As Integer
56.         ReDim nArray(nCount)
57.         For i = 0 To nCount
58.             nArray(i) = ValArray(i)
59.         Next i
60.         CreateArray = nArray
61.     Case vbString
62.         Dim sArray() As String
63.         ReDim sArray(nCount)
64.         For i = 0 To nCount
65.             sArray(i) = ValArray(i)
66.         Next i
67.         CreateArray = sArray
68.     Case vbVariant
69.         Dim vArray()
70.         ReDim vArray(nCount)
71.         For i = 0 To nCount
72.             vArray(i) = ValArray(i)
73.         Next i
74.         CreateArray = vArray
75.     Case vbObject
76.         Dim oArray() As Object
77.         ReDim oArray(nCount)
78.         For i = 0 To nCount
79.             Set oArray(i) = ValArray(i)
80.         Next i
81.         CreateArray = oArray
82.     End Select
83. End Function

Public Function SetXRecord(ByVal DictName As String, ByVal Keyword As String, ByVal XRecordData)     Dim pDict As AcadDictionary     Dim pXRecord As AcadXRecord     Dim XRecordType() As Integer     Dim pLen As Integer         Set pDict = ThisDrawing.Dictionaries.Add(DictName)     Set pXRecord = pDict.AddXRecord(Keyword)         pLen = UBound(XRecordData)     ReDim XRecordType(pLen) As Integer     For i = 0 To pLen         Select Case VarType(XRecordData(i))             Case vbInteger, vbLong                 XRecordType(i) = 70             Case vbSingle, vbDouble                 XRecordType(i) = 40             Case vbString                 XRecordType(i) = 1         End Select     Next i         pXRecord.SetXRecordData XRecordType, XRecordData End Function Public Function GetXRecord(ByVal DictName As String, ByVal Keyword As String) On Error GoTo ErrHandle     Dim pDict As AcadDictionary     Dim pXRecord As AcadXRecord     Dim xt     Set pDict = ThisDrawing.Dictionaries(DictName)     Set pXRecord = pDict.GetObject(Keyword)     pXRecord.GetXRecordData xt, GetXRecord     Exit Function ErrHandle:     GetXRecord = Null End Function Public Function CreateArray(ByVal TypeName As VbVarType, ParamArray ValArray())     Dim nCount As Integer     Dim i     Dim mArray         nCount = UBound(ValArray)         Select Case TypeName     Case vbDouble         Dim dArray() As Double         ReDim dArray(nCount)         For i = 0 To nCount             dArray(i) = ValArray(i)         Next i         CreateArray = dArray     Case vbInteger         Dim nArray() As Integer         ReDim nArray(nCount)         For i = 0 To nCount             nArray(i) = ValArray(i)         Next i         CreateArray = nArray     Case vbString         Dim sArray() As String         ReDim sArray(nCount)         For i = 0 To nCount             sArray(i) = ValArray(i)         Next i         CreateArray = sArray     Case vbVariant         Dim vArray()         ReDim vArray(nCount)         For i = 0 To nCount             vArray(i) = ValArray(i)         Next i         CreateArray = vArray     Case vbObject         Dim oArray() As Object         ReDim oArray(nCount)         For i = 0 To nCount             Set oArray(i) = ValArray(i)         Next i         CreateArray = oArray     End Select End Function

例子

2. Sub tt()
3. Dim arr1(2) As Variant
4. SetXRecord "tlscad", "A", Array(1, 2, "A")
5. SetXRecord "tlscad", "B", Array(3, 4, "B")
6. a = GetXRecord("tlscad", "A")
7. If Not IsNull(a) Then MsgBox a(2)
8. End Sub

Sub tt() Dim arr1(2) As Variant SetXRecord "tlscad", "A", Array(1, 2, "A") SetXRecord "tlscad", "B", Array(3, 4, "B") a = GetXRecord("tlscad", "A") If Not IsNull(a) Then MsgBox a(2) End Sub

yuangw1234

先謝版主了