我这段程序《要求对象的错误》怎么改啊 谢谢哈

z289449174

Public Sub CreateConnection()
    Dim Constr As String
    Set cn = New ADODB.Connection
    cn.CursorLocation = adUseClient
    cn.Provider = "Microsoft.jet.OLEDB.4.0;"
    Constr = "Data Source =D:\cad.mdb;"
    cn.Open Constr
    MsgBox "已经创建了一个到D:\cad.mdb的连接"
End Sub
Public Function HasTable(cn As ADODB.Connection, inputstr As String) As Boolean
         Dim rst As New ADODB.Recordset
      Set rst = cn.OpenSchema(adSchemaTables)
      Dim i As Integer
      For i = 0 To rst.RecordCount - 1
           If UCase(rst.Fields("TABLE_NAME")) = UCase(IputStr) Then
                HasTable = True
                rst.Close
                Exit Function
           End If
           rst.MoveNext
           Next i
           HasTable = False
           rst.Close
End Function
Private Function FindObj(rst As ADODB.Recordset, ID As String) As Boolean
       If rst.RecordCount > 0 Then
       rst.MoveFirst
       While Not rst.EOF
            If Trim(rst.Fields("id")) = ID Then
               FindObj = True
               Exit Function
            End If
            rst.MoveNext
       Wend
       FindObj = False
    Else
       FindObj = False
    End If
End Function

Public Sub AcadWriteToDB()
    Dim cmd As ADODB.Command
    Dim rst As ADODB.Recordset
    Call CreateConnection
         Set cmd = New ADODB.Command
         Set cmd.ActiveConnection = cn
         If HasTable((cn), "line") = False Then
             cmd.CommandText = "CREATE TABLE Line(id char(10),X1 float,Y1 float,X2 float,Y2 float);"
             cmd.Execute
         End If
         If HasTable((cn), "circle") = False Then
             cmd.CommandText = "CREATE TABLE circle(id char(10),CenX float,CenY float,Rad float);"
             cmd.Execute
         End If
         If HasTable((cn), "arc") = False Then
             cmd.CommandText = "CREATE TABLE arc(id char(10),CenX float,CenY float,Rad float," & "StartAng float,EndAng float);"
             cmd.Execute
         End If
         Set rst = New ADODB.Recordset
         rst.CursorLocation = adUseClient
         Dim pt1 As Variant, pt2 As Variant
         Dim obj As AcadEntity
         For Each obj In ThisDrawing.ModelSpace
             Select Case obj.ObjectName
                 Case "acdbline":
                      rst.Open "SELECT id FORM line", cn, adOpenForwardOnly, adLockReadOnly, adCmdText
                      pt1 = obj.StarPoint
                      pt2 = obj.EndPoint
                      If Not FindObj((rst), obj.ObjectID) Then
                          cmd.CommandText = "INSERT INTO line(id,X1,Y1,X2,Y2)VALUES(" & "'" & obj.ObjectID & "','" & pt1(0) & "','" & pt1(1) & "'," & pt2(0) & "," & pt2(1) & ");"
                      Else
                          cmd.CommandText = "UPDATE line SET X1 = " & pt1(0) & ",Y1 = " & pt1(1) & ",X2 = " & pt2(0) & ",Y2 = " & pt2(1) & "WHERE id = '" & obj.ObjectID & "';"
                      End If
                      cmd.Execute
                      rst.Close
                 Case "acdbcircle":
                      rst.Open "SELECT id FORM circle", cn, adOpenForwardOnly, adLockReadOnly, adCmdText
                      pt1 = obj.Center
                      If Not FindObj((rst), obj.ObjectID) Then
                          cmd.CommandText = "insert into circle(id,cenx,ceny,rad)values('" & obj.ObjectID & "'," & "'" & pt1(0) & "','" & pt1(1) & "','" & obj.Radius & "' , ) ; "
                      Else
                          cmd.CommandText = "UPDATE circle SET CenX =" & pt1(0) & ",CenY = " & pt1(1) & ",Rad = " & obj.Radius & "WHERE id = '" & obj.ObjectID & "';"
                      End If
                      cmd.Execute
                      rst.Close
                     
                 Case "AcDbArc":
                       rst.Open "SELECT id FORM arc", cn, adOpenForwardOnly, adLockReadOnly, adCmdText
                       pt1 = obj.Center
                       If Not FindObj((rst), obj.ObjectID) Then
                          cmd.CommandText = "INSERT INTO arc(id,CenX,CenY,Rad,StartAng,EndAng)VALUES('" & obj.ObjectID & "'," & " '" & pt1(0) & "','" & pt1(1) & "','" & obj.Radius & "','" & obj.StartAngle & "','" & obj.EndAngle & "' ) ; "
                       Else
                        
                             cmd.CommandText = "update arcset cenx =" & pt1(0) & ",ceny=" & pt1(1) & ",rad=" & obj.Radius & " ,startang=" & obj.StartAngle & "," & "endang=" & obj.EndAngle & "where id='" & obj.ObjectID & "';"

                           
                       End If
                       
                       cmd.Execute
                       rst.Close
                End Select
              Next obj
              
              
              Set cmd = Nothing
              cn.Close
              Set cn = Nothing
End Sub

z289449174

小弟我正在做毕业设计  急需各位大哥帮个忙哈