[求助]真的需要这样的lisp程序，请帮助编写，先谢了（已解决）

changch · 发表于 2004-10-9 09:59:00

本帖最后由作者于 2004-10-9 13:53:42 编辑

LISP程序编写：

1、提供w1.dat

内容：

(20 15 10 8)

(23 19 6 18)

(45 30 12 13)

(22 17 18 56)

(33 20 45 50)

(5 40 34 27)

2、带DCL对话框，对话框含有：确定按扭、取消按扭、并且能显示w1.dat各行的内容，可供选择每一行的内容

3、当选择对话框w1.dat任一行的内容时，要求将该行的4个数据，分别写在AutoCAD绘图

中的已知的4个点上，字高为5。

4、已知的4个点座标：pt1(0,0）　pt2（0,20）　pt3（0,40）　pt4（0,60）

要求都写详细了，请各位朋友帮助解决，不胜感激！！！！！

changch · 发表于 2004-10-9 11:06:00

我相信咱们版的实力的，再等等

祝福各位热心的人

alin · 发表于 2004-10-9 12:56:00

(defun c:test (/ dcl_id dclfn f datalst line data)
(vl-load-com)
(setq dclfn (vl-filename-mktemp "test.dcl"))
(setq f (open dclfn "w"))
(mapcar '(lambda (x) (write-line x f))
'("Test: dialog { label = "选择数据";"
":list_box { key = "data"; width = 20; height = 10;}"
"ok_cancel;"
"}"
)
)
(close f)
(setq dcl_id (load_dialog dclfn))
(if (null (new_dialog "Test" dcl_id))
(exit)
)
(setq f (open (findfile "w1.dat") "r"))
(setq datalst nil)
(while (setq line (read-line f))
(setq datalst (cons line datalst))
)
(close f)
(setq datalst (reverse datalst))
(start_list "data")
(mapcar 'add_list datalst)
(end_list)
(action_tile
"data"
"(if (= $reason 4)
(progn
(setq data (nth (atoi $value) datalst))
(done_dialog 1)
)
)"
)
(action_tile
"accept"
"(setq data (nth (atoi (get_tile "data")) datalst))(done_dialog 1)"
)
(if (= (start_dialog) 1)
(AddTexts (read data))
)
(unload_dialog dcl_id)
(vl-file-delete dclfn)
(princ)
)
;;;;----------------------------------
(defun AddTexts (txtlst / mspace ptlst)
(setq mspace (vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
)
(setq ptlst
(mapcar 'vlax-3d-point '((0 0 0) (0 20 0) (0 40 0) (0 60 0)))
)
(mapcar '(lambda (pt txt) (vla-addtext mspace txt pt 5.0))
ptlst
txtlst
)
(vlax-release-object mspace)
)

(defun c:test (/ dcl_id dclfn f datalst line data)
   (vl-load-com)
   (setq dclfn (vl-filename-mktemp "test.dcl"))
   (setq f (open dclfn "w"))
   (mapcar '(lambda (x) (write-line x f))
     '("Test: dialog { label = "选择数据";"
         ":list_box { key = "data"; width = 20; height = 10;}"
         "ok_cancel;"
         "}"
         )
     )
   (close f)
   (setq dcl_id (load_dialog dclfn))
   (if (null (new_dialog "Test" dcl_id))
       (exit)
       )
   (setq f (open (findfile "w1.dat") "r"))
   (setq datalst nil)
   (while (setq line (read-line f))
       (setq datalst (cons line datalst))
       )
   (close f)
   (setq datalst (reverse datalst))
   (start_list "data")
   (mapcar 'add_list datalst)
   (end_list)
   (action_tile
       "data"
       "(if (= $reason 4)
                                                     (progn
                                                         (setq data (nth (atoi $value) datalst))
                                                         (done_dialog 1)
                                                     )
                                             )"
       )
   (action_tile
       "accept"
       "(setq data (nth (atoi (get_tile "data")) datalst))(done_dialog 1)"
       )
   (if (= (start_dialog) 1)
       (AddTexts (read data))
       )
   (unload_dialog dcl_id)
   (vl-file-delete dclfn)
   (princ)
   )
;;;;----------------------------------
(defun AddTexts  (txtlst / mspace ptlst)
   (setq  mspace (vla-get-modelspace
     (vla-get-activedocument (vlax-get-acad-object))
     )
  )
   (setq  ptlst
   (mapcar 'vlax-3d-point '((0 0 0) (0 20 0) (0 40 0) (0 60 0)))
  )
   (mapcar '(lambda (pt txt) (vla-addtext mspace txt pt 5.0))
     ptlst
     txtlst
     )
   (vlax-release-object mspace)
   )

changch · 发表于 2004-10-9 13:45:00

好高兴啊！！！！非常谢谢alin

changch · 发表于 2004-10-14 15:59:00

为alin版主献花以表感谢！！！！

账号		自动登录	找回密码
密码			注册