菜鸟求助:实现不了功能帮忙看看指点指点

sbati

根据 <<AutoCAD精彩实例教程>>看的,做gis辅助工具,就想实现把图型中各个点的坐标等信息导入数据库,但现在有问题,坐标能捕捉到但好象数据传不到书库库

Option Explicit
Dim daoDb As DAO.Database   '数据库对象
Dim daoRs As DAO.Recordset  '记录集对象
Dim strPath As String

Private Sub cmdAdd_Click()
    On Error GoTo errHandle

    '添加一条记录
    daoRs.AddNew
   
    ExchangeData True
   
    daoRs.Update
   
errHandle:
    If Err.Number = 3022 Then
        MsgBox "首先修改文本框中的数值，然后单击“添加”按钮，完成添加的操作。", vbCritical
    End If
    Err.Clear
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdFirst_Click()
    '转到第一条记录
    daoRs.MoveFirst
   
    ExchangeData False
End Sub

Private Sub cmdLast_Click()
    '转到最后一条记录
    daoRs.MoveLast
   
    ExchangeData False
End Sub

Private Sub cmdNext_Click()
    On Error Resume Next

    If Not daoRs.EOF Then
        daoRs.MoveNext
    Else
        daoRs.MoveLast
    End If
   
    ExchangeData False
End Sub

Private Sub cmdDelete_Click()
    On Error Resume Next
   
    If MsgBox("删除当前记录？", vbYesNo, "确认删除") = vbYes Then
        daoRs.Delete
       
        If daoRs.EOF Then
            daoRs.MoveLast
        Else
            daoRs.MoveNext
        End If
    End If
   
    ExchangeData False
End Sub

Private Sub cmdPickPt_Click()
Dim ptPick As Variant
Form1.Hide
ptPick = ThisDrawing.Utility.GetPoint(, "指定点")
txtptStX.Text = ptPick(0)
txtptStY.Text = ptPick(1)
Form1.Show
End Sub

Private Sub cmdPrevious_Click()
    On Error Resume Next
   
    If daoRs.BOF Then
        daoRs.MoveFirst
    Else
        daoRs.MovePrevious
    End If
   
    ExchangeData False
End Sub

Private Sub cmdSave_Click()
    '修改数据库中的元素
    daoRs.Edit
   
    ExchangeData True
   
    daoRs.Update
End Sub

Private Sub UserForm_Initialize()
    '必须首先获得当前的工程路径
    strPath = ThisDrawing.Application.VBE.ActiveVBProject.FileName

    '连接数据库
    Set daoDb = OpenDatabase(Left(strPath, Len(strPath) - 8) & "temp.mdb")
    Set daoRs = daoDb.OpenRecordset("temp", 2)
   
    '读取数据库
    If daoRs.RecordCount <> 0 Then
        daoRs.MoveFirst
       
        ExchangeData False
    End If
End Sub

Private Sub UserForm_Terminate()
    '关闭数据库和记录集
    daoRs.Close
    daoDb.Close
End Sub

Private Sub ExchangeData(ByVal bSave As Boolean)
    If bSave Then
        daoRs.Fields("工程编号") = txtId.Text
        daoRs.Fields("X坐标)") = txtptStX.Text     '保存内容仍可使用字段名称或者索引号访问数据库内容
        daoRs.Fields("Y坐标") = txtptStY.Text
        daoRs.Fields("本点号") = bdian.Text
        daoRs.Fields("上点号") = sdian.Text
        daoRs.Fields("类型") = lxing.Text
    Else
        txtId.Text = daoRs.Fields("工程编号")   '根据字段名称或者索引均可以访问其内容
        txtptStX.Text = daoRs.Fields("X坐标")
        txtptStY.Text = daoRs.Fields("Y坐标")
        bdian.Text = daoRs.Fields("本点号")
        sdian.Text = daoRs.Fields("上点号")
        lxing.Text = daoRs.Fields("类型")
    End If
End Sub

songzhi

有条件的吧！

首先要在引用中添加DAO，其次你要有一个数据库，结构和程序中使用的一样。