Lisp 语言环境下的ODBC数据库接口-LISPODBC,在哪里能找到. - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区

兰州人 发表于 2006-7-14 13:08:00

Lisp 语言环境下的ODBC数据库接口--LISPODBC,在哪里能找到.

在<A href="http://www.erphome.net/papers/CAD/AUTOTABL.DOC" target="_blank" >http://www.erphome.net/papers/CAD/AUTOTABL.DOC</A>
<A href="http://www.erphome.net/papers/CAD/AutolispApp.html" target="_blank" >http://www.erphome.net/papers/CAD/AutolispApp.html</A>
发表的文章题目是:
在AutoCAD环境中快速翻阅工程设计图表
本文介绍的方法是利用一个LISP语言访问DBASE/Foxpro数据库的接口程序LISPBASE为支持手段实现的。在DOS环境下，图块以分立的DWG文件的形式存放，在数据库中存放访问路径。在Windows环境下，可以进一步用OLE功能以链接或嵌人方式存放DWG文件，LISPBASE for Windows 提供一个专用函数解决OLE嵌人对象输出到临时文件的问题。在数据库中以嵌人方式存放DWG图块时，要把图块插入到当前编辑的图形文件中还有一个途径。就是直接读取OLE对象数据，过滤掉OLE嵌入对象的图元表现数据，把DWG文件的ENTITY数据用LISP语言提供的函数构造成BLOCK表并插入图形文件中。这个方案的实现所需要的函数将在LISPBASE的新版本中提供。Windows环境方案的优点是可以进一步实现图文并茂的工程文档设计和管理集成系统。缺点是系统开销大，如果希望建立工程文档设计和管理集成系统，微机应配备16兆内存。用DOS环境的方案优点是速度快，开销小。唯一的缺点是无法利用Windows的OLE功能实现图文并茂的工程文档设计和管理集成系统。而这样一个集成系统对一个小组以上规模的设计或生产单位的效益是十分显著的。
我测试了一下
(xload"lispbase")在操作中不能运行,是否有这个功能?

HANDBOOK ;;;;;;;;;;;;;;;;;;;;;;<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
(defun handbook( / dcl_id templist rlist tempstr name)<o:p></o:p>
 (setq dcl_id (load_dialog "handbook"))<o:p></o:p>
 (if (not(new_dialog "handbook" dcl_id)) (exit))<o:p></o:p>
 (if (null use) (xload"lispbase"))<o:p></o:p>
 (setq hbook (use 0 "handbook.dbf"))<o:p></o:p>
 (if (/= hbook 0) (exit))<o:p></o:p>
 (setq templist (list))<o:p></o:p>
 (while (/= (eof hbook) 1)<o:p></o:p>
  (setq rlist (getrec hbook))<o:p></o:p>
  (setq tempstr (strcat (nth 1 rlist) (nth 2 rlist)))<o:p></o:p>
  (setq templist (append templist (list tempstr)))<o:p></o:p>
  (skip hbook 1)<o:p></o:p>
 )<o:p></o:p>
 (start_list "tablelist")<o:p></o:p>
 (mapcar 'add_list templist)<o:p></o:p>
 (end_list)<o:p></o:p>
 (action_tile "accept" "(setq name (select_row))(done_dialog)(princ)")<o:p></o:p>
 (action_tile "cancel" "(done_dialog)(unload_dialog dcl_id)(princ)")<o:p></o:p>
 (action_tile "tablelist" "(setq name (select_row))(done_dialog)(princ)")<o:p></o:p>
 (start_dialog)<o:p></o:p>
 (shut hbook)<o:p></o:p>
 (unload_dialog dcl_id)<o:p></o:p>
 (if (> (length name) 0) (display name))<o:p></o:p>
)<o:p></o:p>
 <o:p></o:p>
;;;display table;;;;<o:p></o:p>
(defun display( name / tablename filename s l i title str f r rlist<o:p></o:p>
 templist tempstr dcl_id sld_name)<o:p></o:p>
 (setq tablename (packname (car name)) filename (packname (cadr name)))<o:p></o:p>
 (setq fileid (use 0 Filename))<o:p></o:p>
 (if (/= fileid 0) (progn (alert "Can't open data table...")(exit)))<o:p></o:p>
 (setq s (stru fileid))<o:p></o:p>
 (setq l (length s) i 0)<o:p></o:p>
 (setq title "" str "------------------------------------")<o:p></o:p>
 (while (</o:p>
  (progn<o:p></o:p>
  (setq m (atoi (substr (nth i s) 14 2)))<o:p></o:p>
  (if (> m 10)<o:p></o:p>
   (setq title (strcat title (substr (nth i s) 1 10) (substr str 1 (- m 10)) " "))<o:p></o:p>
   (setq title (strcat title (substr (nth i s) 1 m ) " "))<o:p></o:p>
  )<o:p></o:p>
  (setq i (1+ i))<o:p></o:p>
  )<o:p></o:p>
 )<o:p></o:p>
 (setq f(open "table.dcl" "w"))<o:p></o:p>
 (write-line "table:dialog{" f)<o:p></o:p>
 (write-line (strcat " label=\"" tablename "\";") f)<o:p></o:p>
 (if (/= (findfile (packname(nth 2 name))) nil)<o:p></o:p>
  (progn<o:p></o:p>
  (write-line " :boxed_row {" f)<o:p></o:p>
  (write-line "  :image {" f)<o:p></o:p>
  (write-line "   key=\"picture1\";" f)<o:p></o:p>
  (write-line "   color=0;" f)<o:p></o:p>
  (write-line "   height=10;" f)<o:p></o:p>
  (write-line "   width=12;" f)<o:p></o:p>
  (write-line "  }" f)<o:p></o:p>
  (if (/= (findfile (packname(nth 3 name))) nil)<o:p></o:p>
   (progn<o:p></o:p>
   (write-line "  :image {" f)<o:p></o:p>
   (write-line "   key=\"picture2\";" f)<o:p></o:p>
   (write-line "   color=0;" f)<o:p></o:p>
   (write-line "   height=10;" f)<o:p></o:p>
   (write-line "   width=12;" f)<o:p></o:p>
   (write-line "  }" f)<o:p></o:p>
   (if (/= (findfile (packname(nth 4 name))) nil)<o:p></o:p>
    (progn<o:p></o:p>
    (write-line "  :image {" f)<o:p></o:p>
    (write-line "   key=\"picture3\";" f)<o:p></o:p>
    (write-line "   color=0;" f)<o:p></o:p>
    (write-line "   height=10;" f)<o:p></o:p>
    (write-line "   width=12;" f)<o:p></o:p>
    (write-line "  }" f)<o:p></o:p>
    )<o:p></o:p>
   )<o:p></o:p>
   )<o:p></o:p>
  )<o:p></o:p>
  (write-line " }" f)<o:p></o:p>
  )<o:p></o:p>
 )<o:p></o:p>
 (write-line " :list_box{" f)<o:p></o:p>
 (write-line (strcat "  label=\"" (substr title 1 74) "\";") f)<o:p></o:p>
 (write-line "  key=\"table\";" f)<o:p></o:p>
 (setq m (+ (strlen title) 2))<o:p></o:p>
 (if (< m 30) (setq m 30))<o:p></o:p>
 (setq testname name)<o:p></o:p>
 (if (or (> m 74) (/= (findfile (packname(nth 4 name))) nil)) (setq m 74))<o:p></o:p>
 (write-line (strcat "  width=" (itoa m) ";") f)<o:p></o:p>
 (write-line " }" f)<o:p></o:p>
 (write-line " ok_cancel;" f)<o:p></o:p>
 (write-line "}" f)<o:p></o:p>
 (close f)<o:p></o:p>
 (setq dcl_id (load_dialog "table"))<o:p></o:p>
 (if (not(new_dialog "table" dcl_id)) (exit))<o:p></o:p>
 (setq templist (list) str "                                      ")<o:p></o:p>
 (while (= (eof fileid) 0)<o:p></o:p>
  (setq tempstr "")<o:p></o:p>
  (setq rlist (getrec fileid) i 0)<o:p></o:p>
  (while (</o:p>
   (cond ((= (substr (nth i s) 12 1) "C")<o:p></o:p>
          (setq tempstr (strcat tempstr (nth (1+ i) rlist) " ")))<o:p></o:p>
        ((= (substr (nth i s) 12 1) "N")<o:p></o:p>
          (progn<o:p></o:p>
          (setq r (rtos (nth (1+ i) rlist) 2 (atoi (substr (nth i s) 17 1))))<o:p></o:p>
          (setq sl (strlen r))<o:p></o:p>
          (setq tempstr (strcat tempstr (substr str 1 (- (atoi (substr (nth i s) 14 2)) sl)) r " "))<o:p></o:p>
          )<o:p></o:p>
        )<o:p></o:p>
   )<o:p></o:p>
   (setq i (1+ i))<o:p></o:p>
  )<o:p></o:p>
  (setq templist (append templist (list tempstr)))<o:p></o:p>
  (skip fileid 1)<o:p></o:p>
 )<o:p></o:p>
 (start_list "table")<o:p></o:p>
 (mapcar 'add_list templist)<o:p></o:p>
 (end_list)<o:p></o:p>
 (setq sldname (nth 2 name))<o:p></o:p>
 (if (/= (findfile sldname) nil)<o:p></o:p>
  (set_image sldname "1")<o:p></o:p>
 )<o:p></o:p>
 (setq sldname (nth 3 name))<o:p></o:p>
 (if (/= (findfile sldname) nil)<o:p></o:p>
  (set_image sldname "2")<o:p></o:p>
 )<o:p></o:p>
 (setq sldname (nth 4 name))<o:p></o:p>
 (if (/= (findfile sldname) nil)<o:p></o:p>
  (set_image sldname "3")<o:p></o:p>
 )<o:p></o:p>
 (action_tile "accept" "(setq r(get_row))(done_dialog)")<o:p></o:p>
 (action_tile "cancel" "(done_dialog)(princ)")<o:p></o:p>
 (action_tile "tablelist" "(setq r(get_row))(done_dialog)")<o:p></o:p>
 (start_dialog)<o:p></o:p>
 (unload_dialog dcl_id)<o:p></o:p>
 (shut fileid)<o:p></o:p>
 (if (listp r)<o:p></o:p>
  (setq r (cdr r))<o:p></o:p>
 )<o:p></o:p>
)<o:p></o:p>
 <o:p></o:p>
 <o:p></o:p>
;;;;select_row;;;;<o:p></o:p>
(DEFUN select_row(/ recid record )<o:p></o:p>
 (setq recid (1+ (atoi (get_tile "tablelist"))))<o:p></o:p>
 (goto hbook recid)<o:p></o:p>
 (setq record (getrec hbook))<o:p></o:p>
 (list (nth 1 record) (nth 3 record) (nth 4 record) (nth 5 record) (nth 6 record))<o:p></o:p>
)<o:p></o:p>
 <o:p></o:p>
(defun get_row(/ recid )<o:p></o:p>
 (setq recid (1+ (atoi (get_tile "table"))))<o:p></o:p>
 (goto fileid recid)<o:p></o:p>
 (getrec fileid)<o:p></o:p>
)<o:p></o:p>
 <o:p></o:p>
(defun packname(fn / i j)<o:p></o:p>
 (if (/= fn nil)<o:p></o:p>
  (progn<o:p></o:p>
  (setq i 1 j (strlen fn))<o:p></o:p>
  (while (and (/= (substr fn i 1) " ") (<= i j)) (setq i(1+ i)))<o:p></o:p>
  (if (<= i j)<o:p></o:p>
   (progn<o:p></o:p>
   (setq i(1- i))<o:p></o:p>
   (setq fn (substr fn 1 i))<o:p></o:p>
   )<o:p></o:p>
   (setq fn fn)<o:p></o:p>
  )<o:p></o:p>
  )<o:p></o:p>
 )<o:p></o:p>
)<o:p></o:p>
 <o:p></o:p>
;;;;;;set_image;;;;;;;;;<o:p></o:p>
(defun set_image(sldname id / x y )<o:p></o:p>
  (setq x (dimx_tile (strcat "picture" id))<o:p></o:p>
        y (dimy_tile (strcat "picture" id)))<o:p></o:p>
 (start_image (strcat "picture" id))<o:p></o:p>
 (slide_image 0 0 x y sldname)<o:p></o:p>
 (end_image)<o:p></o:p>
)<o:p></o:p>
 <o:p></o:p>

ZZXXQQ 发表于 2006-7-14 16:17:00

XLOAD是加载ADS应用程序的。下面的文字来自ACAD的帮助：
加载一个 ADS 应用程序
(xload application ) 
application 参数既可以是一个由双引号引起来的可执行文件名，又可以是一个包含了可执行文件名的变量。在加载文件时，会检查该 ADS 应用程序的有效性。另外，还会对 ADS 程序的版本、ADS 本身和正在运行的 AutoLISP 版本作兼容性检查。
如果 xload 操作失败，它通常会引发一个 AutoLISP 错误。然而，如果提供了 onfailure 参数，在操作失败时 xload 函数会返回该参数的值，而不会发出一条错误信息。
如果成功加载指定的应用程序，本函数返回应用程序名。
(xload "/myapps/xapp")  如果成功，返回 "/myapps/xapp"
如果试图加载一个已经加载的应用程序，xload 函数会发出如下信息：
已加载应用程序“application” 
并返回应用程序名。在调用 xload 函数之前，可以调用 ads 函数来检查当前已加载的 ADS 应用程序。

页: [1]

明经CAD社区's Archiver

Lisp 语言环境下的ODBC数据库接口--LISPODBC,在哪里能找到.