lisp语句操作ACCESS数据库的例子

;(setq con (tls-ado-opencon (strcat (vla-get-path

(vlax-get-acad-object)) "/tlscad/bin/house.mdb")))

;(tls-ado-runtrans con "insert into houseinfo

values(´1´,´2´,´0001´,67,´zh´,23,´lzh´,4,´´)")

;(setq rs (tls-ado-openrs con "select * from houseinfo order by

place,name,hid"))

;(tls-ado-fields->list rs)

;(tls-ado-movefirst rs)

;(tls-ado-movenext rs)

;(vla-close rs)

;(vla-close con)

(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

)

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

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

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

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

(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 ´vlax-invoke-method

(list con "Execute" sql nil nil)

)

)

(vlax-invoke-method con "CommitTrans")

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

)

(defun c:fado( / objname obj attribs attrib sql con rs lst str i

val namelst count)

(setq objname "" sql "" str "")

(while (not (= objname "AcDbBlockReference"))

(setq obj (vlax-ename->vla-object (car (entsel

"\n选择房屋:"))))

(setq objname (vla-get-objectname obj))

)

(setq attribs (vlax-safearray->list

(vlax-variant-value (vla-getattributes obj))))

(foreach attrib attribs

(setq sql (strcat sql (vla-get-tagstring attrib) "=´"

(vla-get-textstring attrib) "´ and "))

)

(setq sql

(strcat

"select * from houseinfo where "

(substr sql 1 (- (strlen sql) 5))

" order by place,name,hid"

)

)

(setq con (tls-ado-opencon (findfile "house.mdb"))

rs (tls-ado-openrs con sql)

lst (tls-ado-fields->list rs)

)

(vla-close rs)

(vla-close con)

(setq namelst ´("地点:" "名称:" "房号:" "面积:" "类别:" "价格:" "房主:" "人口:"

"备注:"))

(setq count 0)

(repeat 9

(setq i (nth count lst))

(if (not i) (setq i ""))

(setq val (vl-catch-all-apply ´rtos (list i))

val (if (vl-catch-all-error-p val) i val)

str (strcat str "\n" (nth count namelst) val)

count (1+ count)

)

)

(alert str)

(princ)

)