[求助]：关于cao库中的createlink 方法

catchy_sky

各位老大，cao库中的createLink方法中的关键值keys要怎样赋值呀？
比如说：dim keys as new cao.keyvalues
                dim keyval as new cao.keyvalue
                dim lint as cao.link
                 keys.clear
                 keyval.value = rsSpaces!SPACE_ID
                 keys.Add keyval
                set objlink=Linkt.createlink(objpoly,objectID, keys)
以上语句编译时老是通不过，错误在 keys.add keyval 这里。
还望各位老大多多指教

efan2000

还没对KeyValue对象赋值吧，先设置FieldName 、Value属性，设置完后，再调用Add 方法试试。

catchy_sky

Sub populateOfficeDatabase()

    ' Variables for AutoCAD objects
    Dim objPoly As AutoCAD.AcadLWPolyline
    Dim objText As AutoCAD.AcadText
    Dim polySel As AutoCAD.AcadSelectionSet

    ' Variables for ADO objects
    Dim rsSpaces As New ADODB.Recordset
    Dim rsUseTypes As New ADODB.Recordset
    Dim rsEmployee As New ADODB.Recordset
    Dim rsDepartment As New ADODB.Recordset

    ' Variables for DCO objects
    Dim LinkT As CAO.LinkTemplate
    Dim keys As New CAO.KeyValues
    Dim keyval As New CAO.KeyValue
    Dim objLink As CAO.link

    ' Other variables
    Dim wsPath As String
    Dim useType As String
    Dim DeptName(1 To 6) As String
    Dim i As Long

    ' Store the department names in an array
    DeptName(1) = "Civil Engineering"
    DeptName(2) = "Architecture"
    DeptName(3) = "Planning"
    DeptName(4) = "Landscape Architecture"
    DeptName(5) = "Surveying"
    DeptName(6) = "Admin"

    ' Verify that the SPACES link template exists
    On Error Resume Next
    Set LinkT = getLinkTemplate(SpacesLink)
    If Err <> 0 Then
        MsgBox "You must first create a Link Template named '" & _
            SpacesLink & "'" & _
            vbCrLf & "based on the SPACES_QUERY table (SPACE_ID field)", _
            vbOKOnly, "Office Example"
        Exit Sub
    End If
    On Error GoTo 0

    ' Verify that the user really wants to do this
    If MsgBox("This will clear the OFFICE database " & _
            "and delete all links. Do you want to continue?", _
            vbYesNo, "Office Example") = vbNo Then
        Exit Sub
    End If

    ' Delete all links associated with this link template
    ThisDrawing.Utility.Prompt "Deleting links..." & vbCrLf
    For Each objLink In getDbConnect().GetLinks(LinkT)
        objLink.Delete
    Next

    ' Open the database
    openConnection SpacesLink

    ' Delete all rows from all tables
    ' (in case we run this macro more than once)
    ThisDrawing.Utility.Prompt "Clearing the database..." & vbCrLf
    getAdoConnection().Execute "delete from employee"
    getAdoConnection().Execute "delete from spaces"
    getAdoConnection().Execute "delete from use_types"
    getAdoConnection().Execute "delete from department"

    ' Open the Recordset objects
    rsSpaces.Open "SPACES", getAdoConnection(), _
        adOpenDynamic, adLockOptimistic
    rsUseTypes.Open "USE_TYPES", getAdoConnection(), _
        adOpenDynamic, adLockOptimistic
    rsEmployee.Open "EMPLOYEE", getAdoConnection(), _
        adOpenDynamic, adLockOptimistic
    rsDepartment.Open "DEPARTMENT", getAdoConnection(), _
        adOpenDynamic, adLockOptimistic

    ' Iterate through the space polygons and populate the database
    Set polySel = getSpacePolylineSelection()
    For Each objPoly In polySel

        ' Find a text object inside the polygon
        Set objText = getTextInsidePolygon(objPoly)
        If Not objText Is Nothing Then

            ' Determine what the use of the space is. If the polygon
            ' color is set, then it's an office and the text is the
            ' employee name or "Vacant". Otherwise use the text value
            ' found inside the polygon as the use type.
            useType = "Office"
            If objPoly.Color = acByLayer Then
                useType = objText.TextString
                If useType = "Vacant" Then
                    useType = "Office"
                End If
            End If

            ' Add the use type to the USE_TYPES table if it does not exist
            rsUseTypes.Find "TYPE_NAME='" & useType & _
                "'", , , adBookmarkFirst
            If rsUseTypes.EOF Then
                rsUseTypes.AddNew
                rsUseTypes!TYPE_NAME = useType
                rsUseTypes.Update
            End If

            ' Add a new row to the spaces table
            rsSpaces.AddNew
            rsSpaces!TYPE_ID = rsUseTypes!TYPE_ID
            rsSpaces.Update

            ' Set up the key value for the link
            keys.Clear
            keyval.Value = rsSpaces!SPACE_ID
            keys.Add keyval

            ' Create the link on the polygon
            Set objLink = LinkT.CreateLink(objPoly.ObjectID, keys)

            ' This is an occupied office...
            If objText.Color = acByLayer _
                And objPoly.Color <> acByLayer Then

                ' Add the department name to the DEPARTMENT
                ' table if necessary
                rsDepartment.Find "DEPT_NAME='" & _
                    DeptName(objPoly.Color) & "'", , , adBookmarkFirst
                If rsDepartment.EOF Then
                    rsDepartment.AddNew
                    rsDepartment!DEPT_NAME = DeptName(objPoly.Color)
                    rsDepartment.Update
                End If

                ' Split the first and last name by finding the position
                ' of the separating space
                i = InStr(1, objText.TextString, " ", vbTextCompare)

                ' Add a new row to the employee table and populate it
                rsEmployee.AddNew
                rsEmployee!FIRST_NAME = Left(objText.TextString, i - 1)
                rsEmployee!LAST_NAME = Mid(objText.TextString, i + 1)
                rsEmployee!DEPT_ID = rsDepartment!DEPT_ID
                rsEmployee!SPACE_ID = rsSpaces!SPACE_ID
                rsEmployee.Update
            End If
            ThisDrawing.Utility.Prompt objText.TextString
        End If
    Next

    ' Close the recorset objects
    rsSpaces.Close
    rsUseTypes.Close
    rsEmployee.Close
    rsDepartment.Close

    ' Release the polyline selection object
    Set polySel = Nothing
End Sub
编译时老在keys.add keyval 处出错

efan2000

这句的语法没错，你用下面的代码试试。
End Sub

2. 
   
3.   [FONT=courier new]
   
4. Sub Test()
   
5.     Dim KVs As New CAO.KeyValues
   
6.     Dim KV As New CAO.KeyValue
   
7.     KVs.Clear
   
8.     KV.FieldName = "C"
   
9.     KV.Value = "A"
   
10.     KVs.Add KV
    
11.     MsgBox KVs(0).FieldName & ": " & KVs(0).Value
    
12.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub Test()<br />     Dim KVs As New CAO.KeyValues<br />     Dim KV As New CAO.KeyValue<br />     KVs.Clear<br />     KV.FieldName = "C"<br />     KV.Value = "A"<br />     KVs.Add KV<br />     MsgBox KVs(0).FieldName & ": " & KVs(0).Value<br />   [/FONT]<br />

catchy_sky

好象还是不行，编译时显示Argument not optional (Error 449)
光标还是出现在 keys.add keyval
老大，要不我把图和文件传给你看看

efan2000

你把图和程序上传上来吧，大家帮帮忙看看是什么问题。

catchy_sky

附件中有3个文件，分别为office.dvb, office.mdb, office.dwg
加载office.dvb后运行populatedatabase宏，然后就会出现
上述问题

efan2000

你一步步跟踪一下代码，好像返回的LinkTemplates的数量为0。
在编程中，最好少用On Error Resume Next，应该用On Error GoTo ErrTrap，ErrTrap为你处理错误的跳转标号，这里是你集中处理错误的地方，用Resume只能是一些无法集中处理或者能立刻结束错误的场合，因为它会把错误带到下一个语句和过程。

catchy_sky

efan兄，不好意思，那个联结模板是要自己建的。我忘了把它给联上了，
我现在连好了，再传上来。
我现在还是弄不懂那个add方法到底错在哪。呵呵，还望老大多多指导。

efan2000

缺少数据连接UDL文件。

catchy_sky

恩？office.mdb我在上个压缩包里面就发过了呀，

efan2000

最初由 catchy_sky 发布
[B]恩？office.mdb我在上个压缩包里面就发过了呀， [/B]

不是mdb文件，是udl文件，在CAD目录下，你查找一下。

catchy_sky

udl文件就是用mdb文件建立的，
在dbcconnect中用office.mdb新建数据源，就会生成
udl文件。

efan2000

那个语句没有错误，你跟踪一下是不是数据库的问题，可能它的权限设置成只写的。
下面是我创建的数据链接文件，你用它试一下，在我机上运行时一切正常。

catchy_sky

efan兄，你这个udl是用mdb建的吧，我用这个udl提示我找不到数据源，
因为你是在你的机器上建的udl，可能是mdb在不同的目录下吧。
如果你也是用那个mdb建的话，那就没有问题了，我在自己机器上建也
一样，至于你说的属性问题，我看了一下我的设置，没有问题！
还有我想问一下，你说在你的机器上一切运行正常，是不是所有的polyline都
建立了连接呢？还有office下的数据表有没有自动填充好呢？
我弄这个玩意都快一个月了，人都昏了，如果问了些benben的问题，请多见谅！
：）