很久以前我常常使用CAD中的vlisp语言连接Access数据库，进行画纵断面图。现在发现用以前的程序出现“错误: Automation 错误。 未找到提供程序。该程序可能未正确安装。”的提示。原数据库的连接函数为：

(defun tls-ado-opencon(filename / con connectionstring)

(setq con (vlax-create-object "ADODB.Connection"))

(setq

connectionstring

(strcat

"Provider=Microsoft.Jet.OLEDB.4.0;Data Source="

filename

";Persist Security Info=False"

)

)

(vla-open con connectionstring "" "" -1)

con

)

在网上查找，也找不到解决的办法。后来，我把要用的数据库导入MSSQL，我用的是SQL 2017。改变上述语句为：

(defun tls-ado-opencon(datename / con connectionstring)

(setq con (vlax-create-object "ADODB.Connection"))

(setq connectionstring (strcat "Provider=SQLOLEDB;Data Source=DESKTOP-KREI0UP;Initial Catalog=" datename ";User ID=sa;Password=1"))

(vla-open con connectionstring "" "" -1)

con )

其中DESKTOP-KREI0UP为我的服务器名称，账号为sa，密码为1，数据库名称为函数传递，其中filename改为dataname，这样就实现了数据库连接。

以下是其他数据库连接函数内容：

(defun tls-ado-openrs(con sql / rs)

(setq rs (vlax-create-object "ADODB.Recordset"))

(vlax-put-property rs "CursorLocation" 2)

(vlax-put-property rs "CursorType" 3)

(vla-open rs sql con nil nil nil)

rs

)

(defun tls-ado-getvalue(rs name)

(vlax-variant-value

(vlax-get-property

(vlax-get-property

(vlax-get-property rs "Fields")

"item"

name

)

"value"

)

)

)

(defun tls-ado-getname(rs name)

(vlax-get-property

(vlax-get-property

(vlax-get-property rs "Fields")

"item"

name

)

"name"

)

)

(defun tls-ado-fields->list(rs / count pcount lst curval)

(setq count (vlax-get-property (vlax-get-property rs "Fields") "Count"))

(setq pcount count)

(repeat

count

(setq curval (tls-ado-getvalue rs (setq pcount (1- pcount))))

(setq lst (cons curval lst))

)

)

(defun tls-ado-fieldnames->list(rs / count pcount lst curval)

(setq count (vlax-get-property (vlax-get-property rs "Fields") "Count"))

(setq pcount count)

(repeat

count

(setq curval (tls-ado-getname rs (setq pcount (1- pcount))))

(setq lst (cons curval lst))

)

)

(defun tls-ado-movefirst(rs)

(vlax-invoke-method rs "movefirst")

(tls-ado-fields->list rs)

)

(defun tls-ado-movelast(rs)

(vlax-invoke-method rs "movelast")

(tls-ado-fields->list rs)

)

(defun tls-ado-movenext(rs)

(vlax-invoke-method rs "movenext")

(if (= (vlax-get-property rs "eof") :vlax-false)

(tls-ado-fields->list rs)

nil

)

)

(defun tls-ado-moveprevious(rs)

(vlax-invoke-method rs "moveprevious")

(if (= (vlax-get-property rs "bof") :vlax-false)

(tls-ado-fields->list rs)

nil

)

)

(defun tls-ado-runtrans(con sql / err)

(vlax-invoke-method con "BeginTrans")

(setq err

(vl-catch-all-apply 39;vlax-invoke-method

(list con "Execute" sql nil nil)

)

)

(vlax-invoke-method con "CommitTrans")

(not (vl-catch-all-error-p err))

)

测试一下：

(defun C:hq()

  (vl-load-com)

  (setq zh0 (entsel "\n请选择井号："))

  (setq zhs (entget (car zh0)))

  (setq zhg (assoc 1 zhs))

  (setq zh (cdr zhg))

  (setq biao "jd")

  (setq con2 (tls-ado-opencon "jd"))

  (setq rs2 (tls-ado-openrs con2 (strcat "select * from " biao " where jh = 39;" zh "39; order by id asc")))

  (tls-ado-fields->list rs2)

  (setq te (tls-ado-movefirst rs2))

  (print (car te))

  (print (nth 1 te)) ;片区

  (print (nth 2 te)) ;井号

  (print (nth 3 te)) ;井面标高

  (print (nth 4 te)) ;井底标高

  (print (nth 6 te)) ;Y

  (print (nth 7 te)) ;井深

  (print (nth 11 te)) ;

  (vla-close rs2)

(vla-close con2)

(setq p0 (getpoint "选择井号的中心点："))

(setq x (rtos (car p0) 2 4))

(setq y (rtos (cadr p0) 2 4))

  (setq con (tls-ado-opencon "jd"))

(setq sql (strcat "update jd set x = 39;" x "39;, y = 39;" y "39; where pq = 39;P139; and jh =39;" zh "39;"))

  (tls-ado-runtrans con sql)

  (princ (strcat "已经输入" x "!"))

  (vla-close con)

)

用hq的命令，选择一个井的井号后，点井的位置，获取x，y数值，再输入到数据库中jd表。