明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1627|回复: 0

AutoCad函数的参数的奇怪问题

[复制链接]
发表于 2006-8-18 20:41:00 | 显示全部楼层 |阅读模式
本帖最后由 作者 于 2006-8-20 20:55:58 编辑

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

 

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-27 00:45 , Processed in 0.172061 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表