AutoCad函数的参数的奇怪问题
本帖最后由 作者 于 2006-8-20 20:55:58 编辑 <br /><br /> <PRE style="MARGIN: 1pt 0cm">Sub Example_SetXRecordData()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' This example creates a new XRecord if one doesn't exist,<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' appends data to the XRecord, and reads it back. To see data being added,<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' run the example more than once.<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Dim TrackingDictionary As AcadDictionary, TrackingXRecord As AcadXRecord<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Dim XRecordDataType As Variant, XRecordData As Variant<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Dim ArraySize As Long, iCount As Long<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Dim DataType As Integer, Data As String, msg As String<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' Unique identifiers to distinguish our XRecordData from other XRecordData<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Const TYPE_STRING = 1<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Const TAG_DICTIONARY_NAME = "ObjectTrackerDictionary"<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Const TAG_XRECORD_NAME = "ObjectTrackerXRecord"<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"><o:p> </o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' Connect to the dictionary in which the XRecord is stored<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> On Error GoTo CREATE<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Set TrackingDictionary = ThisDrawing.Dictionaries(TAG_DICTIONARY_NAME)<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Set TrackingXRecord = TrackingDictionary.GetObject(TAG_XRECORD_NAME)<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> On Error GoTo 0<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' Get current XRecordData<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> TrackingXRecord.GetXRecordData XRecordDataType, XRecordData<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' If there is no array already, create one<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> If VarType(XRecordDataType) And vbArray = vbArray Then<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ArraySize = UBound(XRecordDataType) + 1 ' Get the size of the data elements returned<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ArraySize = ArraySize + 1 ' Increase to hold new data<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ReDim Preserve XRecordDataType(0 To ArraySize)<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ReDim Preserve XRecordData(0 To ArraySize)<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Else<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ArraySize = 0<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ReDim XRecordDataType(0 To ArraySize) As Integer<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ReDim XRecordData(0 To ArraySize) As Variant<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> End If<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' Append new XRecord Data<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> '<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' For this sample, we only append the current item to the XRecord<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> XRecordDataType(ArraySize) = TYPE_STRING: XRecordData(ArraySize) = CStr(Now)<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> TrackingXRecord.SetXRecordData XRecordDataType, XRecordData<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' Read back all XRecordData entries<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> TrackingXRecord.GetXRecordData XRecordDataType, XRecordData<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ArraySize = UBound(XRecordDataType)<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' Retrieve and display stored XRecordData<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> For iCount = 0 To ArraySize<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' Get information for this element<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> DataType = XRecordDataType(iCount)<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Data = XRecordData(iCount)<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> If DataType = TYPE_STRING Then<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> msg = msg & Data & vbCrLf<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> End If<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Next<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> MsgBox "The data in the XRecord is: " & vbCrLf & vbCrLf & msg, vbInformation<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Exit Sub<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"><o:p> </o:p></PRE><PRE style="MARGIN: 1pt 0cm">CREATE:<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' Create the objects that hold the XRecordData<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> If TrackingDictionary Is Nothing Then ' Make sure the tracking object is there<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Set TrackingDictionary = ThisDrawing.Dictionaries.Add(TAG_DICTIONARY_NAME)<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Set TrackingXRecord = TrackingDictionary.AddXRecord(TAG_XRECORD_NAME)<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> End If<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Resume<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm">End Sub<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"><FONT face=宋体>这个程序是书上的例子，我把它改了一下<o:p></o:p></FONT></PRE><PRE style="MARGIN: 1pt 0cm"> ' Get current XRecordData<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> TrackingXRecord.GetXRecordData XRecordDataType, XRecordData<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> ' If there is no array already, create one<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> If VarType(XRecordDataType) And vbArray = vbArray Then<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> <FONT face=宋体>在这个下面开始改动，放一个函数<o:p></o:p></FONT></PRE><PRE style="MARGIN: 1pt 0cm"> Dim return_date() as Variant<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> Dim array1() as Variant<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> return_date=search_date(XRecordData,array1)<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"> …………………………<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm; TEXT-INDENT: 50pt; mso-char-indent-count: 5.0">………………………….<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm; TEXT-INDENT: 50pt; mso-char-indent-count: 5.0"><FONT face=宋体>下面是程序的其他部分，知道程序结束。<o:p></o:p></FONT></PRE><PRE style="MARGIN: 1pt 0cm"><FONT face=宋体>先说一下</FONT>search_date(XRecordData,array1)<FONT face=宋体>这个函数，<o:p></o:p></FONT></PRE><PRE style="MARGIN: 1pt 0cm"><FONT face=宋体>完整定义</FONT>Public function search_date(xrecorddata() as Variant ,array1() as Variant)<o:p></o:p></PRE><PRE style="MARGIN: 1pt 0cm"><FONT face=宋体>这个函数的功能是返回</FONT>xrecorddata()<FONT face=宋体>中和</FONT>array1()<FONT face=宋体>中相同的数据，将数据作为一个数组返回<o:p></o:p></FONT></PRE><PRE style="MARGIN: 1pt 0cm"><FONT face=宋体>我出问题的地方就是编译通不过，它说</FONT>return_date=search_date(XRecordData,array1)<FONT face=宋体>调用中</FONT>XRecordData<FONT face=宋体>数据类型不对。</FONT></PRE><PRE style="MARGIN: 1pt 0cm"><FONT face=宋体>可是按照我的想法是</FONT>If VarType(XRecordDataType) And vbArray = vbArray Then<FONT face=宋体>这个语句不是已经判别</FONT>XRecordDataType <FONT face=宋体>和</FONT></PRE><PRE style="MARGIN: 1pt 0cm">XRecordData<FONT face=宋体>都为数组了吗？我的程序大概想法是对一张图纸，首先判断他的字典是否有信息（即由数组</FONT>XRecordData<FONT face=宋体>表示的），</FONT></PRE><PRE style="MARGIN: 1pt 0cm"><FONT face=宋体>如果有数据则和</FONT>array1()<FONT face=宋体>中的数据进行比较，要是没有则把</FONT>array1()<FONT face=宋体>中的数据赋值给</FONT>XRecordData<FONT face=宋体>（），然后用</FONT>SetXRecordData<FONT face=宋体>把</FONT></PRE><PRE style="MARGIN: 1pt 0cm"><FONT face=宋体>值放入字典。我现在没有源代码在家里，在公司了，大家帮我分析一下。<o:p></o:p></FONT></PRE><P class=MsoNormal style="MARGIN: 0cm 0cm 0pt -35.9pt; mso-para-margin-left: -3.42gd"><o:p><FONT face="Times New Roman"> </FONT></o:p></P>
页:
[1]