[源码]64位CAD中Lisp读取ACCESS的方法

cabinsummer

公司装有64位的AutoCAD2012，但是OFFICE套件都是32位的，ACCESS数据库引擎也是32位的。又没有管理员权限装64位数据库引擎。

借助VBA ADO访问ACCESS，将记录写入字典，再通过LISP将字典中的数据读出。

LISP部分:假定dvb文件名为ado.dvb，且在CAD支持路径中，宏名为ado
(defun ado(dbase strrs)
  (vl-load-com)
  (setvar "users4" dbase)
  (setvar "users5" strrs)
  (dictadd (namedobjdict) "MyDict" (entmakex '((0 . "DICTIONARY")(100 . "AcDbDictionary"))))
  (vl-vbaload (findfile "ado.dvb"))
  (vl-vbarun "ado")
  (vl-vbaunload (findfile "ado.dvb"))
  (setq recordset (mapcar '(lambda(w)(mapcar 'cdr (vl-remove-if-not '(lambda(z)(= (car z) 1)) w)))(mapcar '(lambda(y)(entget (cdr y)))(vl-remove-if-not '(lambda(x)(= (car x) 350))(dictsearch (namedobjdict) "MyDict")))))
  (setvar "users4" "")
  (setvar "users5" "")
  (dictremove (namedobjdict) "MyDict")
)

VBA部分，需引用Microsoft ActiveX Data Objects 2.x Library

Dim Cn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim dbase As String
Dim strCn As String
Dim strRs As String

Sub ado()
  Dim fld As ADODB.Field
  Dim Dict As String
  Dim strfld As String
  Dim strRec As String
  Dim i As Integer
  Dim j As Integer
        
  Dim TrackingDictionary As AcadDictionary
  Dim TrackingXRecord As AcadXRecord
  Dim ArraySize As Long
  Dim XRecID As String
  Dim XRecordDataType As Variant
  Dim XRecordData As Variant
   
  dBase = ThisDrawing.GetVariable("users4")
        
  strCn = "Provider=Microsoft.JET.OLEDB.4.0;Data Source=D:\" & dBase & ".mdb"
  strRs = ThisDrawing.GetVariable("users5")
  Cn.Open strCn
  If Left(strRs, 6) = UCase("SELECT") Then
    Set TrackingDictionary = ThisDrawing.Dictionaries.Item("MyDict")
    With Rs
      .Open strRs, Cn, adOpenStatic, adLockOptimistic
      XRecID = "K000"
      Set TrackingXRecord = TrackingDictionary.AddXRecord(XRecID)
      ArraySize = .Fields.Count - 1
      ReDim XRecordDataType(0 To ArraySize) As Integer
      ReDim XRecordData(0 To ArraySize) As Variant
      j = 0
      For Each fld In Rs.Fields
        XRecordDataType(j) = 1
        XRecordData(j) = fld.Name       TrackingXRecord.SetXRecordData XRecordDataType, XRecordData
        j = j + 1
      Next
      i = 1
      Do While Not .EOF
        Select Case i
          Case 1 To 9
            XRecID = "K00" & CStr(i)
          Case 10 To 99
            XRecID = "K0" & CStr(i)
          Case Else
            XRecID = "K" & CStr(i)
          End Select
          Set TrackingXRecord = TrackingDictionary.AddXRecord(XRecID)
          ReDim XRecordDataType(0 To ArraySize) As Integer
          ReDim XRecordData(0 To ArraySize) As Variant
          For j = 0 To ArraySize
            XRecordDataType(j) = 1
            If IsNull(.Fields.Item(j).Value) Then
              XRecordData(j) = ""
            Else
              XRecordData(j) = .Fields.Item(j).Value
            End If
          Next j   TrackingXRecord.SetXRecordData XRecordDataType, XRecordData
        .MoveNext
        i = i + 1
      Loop
      .Close
    End With
  Else
    Cn.Execute (strRs)
  End If
  Cn.Close
End Sub

调用方法:如果存在数据库d:\test.mdb;并且有表test且其中字段都是文本。可在lisp中调用(ado "test" "SELECT * FROM test")来获取表中数据，存放在变量recordset中，之后就可以对recordset进行进一步操作了。函数的第一个参数是放在D盘根目录下的数据库名，第二个参数是SQL语句。SQL语句第一个词是SELECT，则recordset有新数据，如果是INSERT、DELECT、UPDATE等词，则只操作数据库而无新记录返回。本程序没有加入数据库操作出错的处理，所有的功能仅在数据库有效执行的情况下测试。本程序仅说明lisp在不能直接操作数据库时的一种变通方法，直接操作的程序请参考Gu版和无痕的程序。有兴趣的可以发展新功能。

自贡黄明儒

风大师又出马了，欢迎归来。

lostbalance

完全看不懂啊

cabinsummer

手机中输入的，既慢又不美观，明经论坛啥时能彻底搞好啊？

cabinsummer

现在已经完全搞定了，装个AccessDatabaseEngine_X64就可以用以前的32位代码了

oistre

谢谢大神，牛牛牛牛！！！

zag0666

大神,这个arx能否在64位win10下使用,请帮忙看看

nxchenjk

zag0666 发表于 2020-9-22 11:51
大神,这个arx能否在64位win10下使用,请帮忙看看

你是什么目的。没个说明，不知道怎么用啊？？

zag0666

nxchenjk 发表于 2020-9-22 17:43
你是什么目的。没个说明，不知道怎么用啊？？

http://bbs.mjtd.com/thread-181905-1-1.html
这个程序64位用不了，就想着大神的这方式能否用到这程序上来。