autocad vba与数据库的连接

沧海一舟888

本人最近想编一个小程序,用来统计DWG中的零件数据,程序如下,已能运行,但不知道为什么不能录入英文,有哪位大侠能帮忙指导一下,运界面如附件:

Option Explicit
Dim adoCon As Connection    '连接对象
Dim adoRs As Recordset '记录集对象
Dim strPath As String

Private Sub cmdAdd_Click()
    Dim control As control
    For Each control In Form1.Controls
        If TypeOf control Is TextBox Then
            If control.Text = "" Then
                MsgBox "参数不能为空，请重新输入！", vbCritical
                Exit Sub
            End If
        End If
    Next
   
    On Error GoTo errHandle

    '添加新的记录
    With adoRs
        .AddNew
   
        .Fields(0) = txtId.Text
        .Fields(1) = txtptStX.Text
        .Fields(2) = txtptStY.Text
        .Fields(3) = 0
        .Fields(4) = txtptEnX.Text
        .Fields(5) = txtptEnY.Text
        .Fields(6) = 0
       
        .Update
    End With
   
    Exit Sub
errHandle:
    If Err.Number = -2147467259 Then
        MsgBox "首先修改文本框中的数值，然后单击“添加”按钮，完成添加的操作。", vbCritical
    End If
    Err.Clear
   
    '由于添加数据失败，不能更新数据库，故取消更新
    adoRs.CancelUpdate
End Sub

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

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdFirst_Click()
    adoRs.MoveFirst
   
    ExchangeData False
End Sub

Private Sub cmdLast_Click()
    adoRs.MoveLast
   
    ExchangeData False
End Sub

Private Sub cmdModify_Click()
    ExchangeData True
End Sub

Private Sub cmdNext_Click()
    On Error Resume Next
   
    '如果已经到达末尾
    If adoRs.EOF Then
        adoRs.MoveLast
    Else
        adoRs.MoveNext
    End If
   
    ExchangeData False
End Sub

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

Private Sub UserForm_Initialize()
    '必须首先获得当前的工程路径
    strPath = ThisDrawing.Application.VBE.ActiveVBProject.FileName
   
    '连接数据库
    Set adoCon = New Connection
    adoCon.CursorLocation = adUseClient
    adoCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
        Left(strPath, Len(strPath) - 8) & "lineData.mdb;"
   
    '打开记录集
    Set adoRs = New Recordset
    adoRs.Open "ptStEn", adoCon, adOpenDynamic, adLockOptimistic
   
    If adoRs.RecordCount > 0 Then
        adoRs.MoveLast
        adoRs.MoveFirst
       
        ExchangeData False
    End If
End Sub

Private Sub UserForm_Terminate()
    '关闭连接和记录集
    adoRs.Close
    adoCon.Close
End Sub

'bSave参数取True，表示将文本框中的内容保存到数据库中；取False表示读取数据库的内容
Private Sub ExchangeData(ByVal bSave As Boolean)
    If bSave Then
        adoRs.Fields(0) = txtId.Text
        adoRs.Fields("ptst(x)") = txtptStX.Text     '保存内容仍可使用字段名称或者索引号访问数据库内容
        adoRs.Fields("ptst(y)") = txtptStY.Text
        adoRs.Fields(4) = txtptEnX.Text
        adoRs.Fields(5) = txtptEnY.Text
    Else
        txtId.Text = adoRs.Fields("ObjectID")   '根据字段名称或者索引均可以访问其内容
        txtptStX.Text = adoRs.Fields(1)
        txtptStY.Text = adoRs.Fields(2)
        txtptEnX.Text = adoRs.Fields(4)
        txtptEnY.Text = adoRs.Fields(5)
    End If
End Sub