我的技术说明词库
本帖最后由 pannelchen 于 2015-1-22 23:13 编辑由于看了风版主的技术文档库网页，网页地址http://bbs.mjtd.com/thread-92135-1-1.html
想做一个自已的，大家看下，跟风大学的,由于风版 的函数太多，只偷了一点点，其它的还学不来;
主要加了个从其它文件中导入.
另存另存按钮还没有弄，还不会，有知道的可告知下.
其它的慢慢跟据自已所知道的编写，就是不断的读文件写文件.函数不完整，只是让大家看下表的增加，删除，上移，下移我的写法,同大家分享下.
(defun c:multck()
(vl-load-com);加载支持activex的函数的程序代码.(vlisp部分)
(setvar "cmdecho" 0)
(setq lst (sub_readfile))
(dcl_diamultck)
)
(defun dcl_diamultck()
(setq dcl_id (load_dialog "多行文字词库"))
(new_dialog "multck" dcl_id)
(show_list "multck_list" lst)
(show_list "poplay" (alllay))
(show_list "popsty" (allsty))
(action_tile "multck_list" "(sub_cklist $value lst)")
(action_tile "addbutton" "(addlist)")
(action_tile "delbutton" "(dellist)")
(action_tile "upbutton" "(uplist)")
(action_tile "downbutton" "(downlist)")
(action_tile "modbutton" "(modlist)")
(action_tile "getlist" "(done_dialog 1) ")
(action_tile "popsty" "(setq textsty (nth (atoi $value ) (allsty)))")
(action_tile "poplay" "(setq textlay (nth (atoi $value ) (alllay)))")
(action_tile "accept" "(ok_diamultck) (done_dialog 2)")
(setq dd(start_dialog))
(cond
((= dd 1)(sub_getlist))
((= dd 2)(
; (sub_write_cad)
;(setq inpt(getpoint "插入点："))
; (setq inpt2(getpoint "对角点："))
;(entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 7 txtsty ) (cons 8 txtlay) (cons 1 data) (cons 10 inpt) (cons 40 txthh)))
)
)
)
)
(defun ok_diamultck()
(setq lst (sub_readfile))
(setq txthh(get_tile "txthh"))
)
;;重要函数
(defun sub_getlist()
(setq lst (listfromfile))
(sub_writedata lst) ;写入temp.ini
(dcl_diamultck) ;回到对话框
)
(defun show_list(key newlist);字符串转为list
(start_list key);
(mapcar 'add_list newlist)
(end_list)
)
(defun sub_cklist (vvs wordlist);设置key：wordstr初始值
(set_tile "wordstr" (nth (atoi vvs) wordlist))
)
(defun modlist()
(setq wordstr (get_tile "wordstr"))
(setq lst (sub_readfile))
(setq ffn(open "D:\\cad编程练习\\例子\\词库-多行文字\\TEMP词库.ini""w"))
(setq n (atoi (get_tile "multck_list")))
(setq k 0)
(setq data (nth k lst))
(whiledata
(if (/= k n)
(write-line data ffn)
(write-line wordstr ffn)
)
(setq k (1+ k))
(setq data (nth k lst))
)
(close ffn)
(setq lst (sub_readfile))
(show_list "multck_list" lst)
(set_tile "multck_list" (itoa n))
)
(defun addlist()
(setq lst (sub_readfile))
(setq wordstr (get_tile "wordstr"))
(if (/= wordstr "")
(progn
(setq lst (append lst(list wordstr) ))
(sub_writedata lst)
(show_list "multck_list" lst)
(setq len (length lst))
(set_tile "multck_list" (itoa (1- len)))
)
(progn
(alert"所加项目为空值")
(show_list "multck_list" lst)
)
)
)
(defun dellist()
(setq lst (sub_readfile))
(if(/= lst nil)
(progn
(setq n (atoi (get_tile "multck_list")))
(setq deldata(nth n lst))
(setq lst (vl-remove deldata lst)) ;删除表中的元素,表中如果项目相同都会删去
(sub_writedata lst)
(show_list "multck_list" lst)
(setq len (length lst))
(if(< n (1- len))
(set_tile "multck_list" (itoa n))
(set_tile "multck_list" (itoa (1- len)))
)
);;progn
(progn
(alert"空list")
(show_list "multck_list" lst)
)
);if
)
(defun uplist() ;从零往上移后set)tile为0不成功
(setq lst (sub_readfile))
(setq n (atoi (get_tile "multck_list"))) ;得到key值
(setq mdata (nth n lst))
(if (>= n 1)
(progn
(setq upmdata (nth (- n 1) lst))
(setq ffn(open "D:\\cad编程练习\\例子\\词库-多行文字\\TEMP词库.ini""w"))
(setq k 0)
(setq data (nth k lst))
(while data
(cond ((= k (- n 1)) (write-line mdata ffn))
((= kn ) (write-line upmdata ffn))
(t (write-line data ffn))
)
(setq k (1+ k))
(setq data (nth k lst))
)
(close ffn)
(setq lst (sub_readfile))
(show_list "multck_list" lst)
(set_tile "multck_list" (itoa (- n 1)))
);progn
(progn
(alert"上移不了了")
(show_list "multck_list" lst)
;(set_tile "multck_list" 0) ;有错误
)
);if
)
(defun downlist()
(setq wordstr (get_tile "wordstr")) ;得到key值
(setq lst (sub_readfile))
(setq n (atoi (get_tile "multck_list"))) ;得到key值
(setq mdata (nth n lst))
(setq len (length lst))
(if (< (+ n 1) len)
(progn
(setq downmdata (nth (+ n 1) lst))
(setq ffn(open "D:\\cad编程练习\\例子\\词库-多行文字\\TEMP词库.ini""w"))
(setq k 0)
(setq data (nth k lst))
(while data
(cond ((= kn ) (write-line downmdata ffn))
((= k (+ n 1)) (write-line mdata ffn))
(t (write-line data ffn))
)
(setq k (1+ k))
(setq data (nth k lst))
)
(close ffn)
(setq lst (sub_readfile))
(show_list "multck_list" lst)
(set_tile "multck_list" (itoa (1+ n)))
);progn
(progn
(alert"下移不了了")
(show_list "multck_list" lst)
(set_tile "multck_list" (itoa n))
)
)
)
;; 读取文件并按行将文件转换为表,引用明经;
(defun listfromfile()
(setq file(getfiled "选择文件" "" "txt" 2))
(setq fn (openfile "r"))
(setqtmplst '())
(while (setq x (read-line fn))
(setq tmplst (append tmplst(list x)))
)
(close fn)
tmplst
)
;从ini中读转化为字符串
(defun sub_readfile(/ tmplst x fn);TEMP词库
(setq pathfile "D:\\cad编程练习\\例子\\词库-多行文字\\TEMP词库.ini")
(setq file(findfile pathfile))
(if file
(progn
(setq fn (openfile "r"))
(while (setq x (read-line fn))
(setq tmplst(append tmplst(list x)))
)
(close fn)
tmplst
)
nil
)
)
;将字符串写入文本文件 ;引用明经
(defun sub_writedata(lst)
(setq ffn(open "D:\\cad编程练习\\例子\\词库-多行文字\\TEMP词库.ini""w")) ;;写模式.
;(setq n 0)
;(setq data (nth n lst))
;(while data
; (write-line data ffn)
; (setq n (1+ n))
; (setq data (nth n lst))
;)
(foreach x lst (write-line x ffn))
(close ffn);;关闭文件
)
(defun sub_write_cad()
(setq lst (sub_readfile))
(setq len (length lst))
(if lst
(progn
(setq n 0 txt "")
(repeat len
(setq txt (strcat txt (itoa (1+ n)) "." (nth n lst) "\\P" )) ;把表转化为字符串，好方法
(setq n (1+ n))
)
(vl-string-right-trim "\\P" txt) ;从字符串删除结尾字符
)
nil
)
)
;;;;vlisp取得所有图层列表.forearch类似,引用书
(defun alllay(/ xobj laylist)
(setq acadobj (vlax-get-acad-object))
(setq dwgobj (vla-get-ActiveDocument acadobj))
(setq layers (vla-get-layers dwgobj));;取得图层集合对象
(setq laylist nil)
(vlax-for xobj layers
(setq layname (vla-get-name xobj))
(setq laylist (cons layname laylist))
)
;(setq laylist (acad_strlsort laylist))
(setq laylist (vl-sort laylist '<))
)
;;;;vlisp取得所有样式列表引用书
(defun allsty(/ xobj stylist)
(setq acadobj (vlax-get-acad-object))
(setq dwgobj (vla-get-ActiveDocument acadobj))
(setq styles (vla-get-textstyles dwgobj));;取得图层集合对象
(setq stylist nil)
(vlax-for xobj styles
(setq styname (vla-get-name xobj))
(setq stylist (cons styname stylist))
)
;(setq stylist (acad_strlsort stylist))
(setq stylist (vl-sort stylist '<))
)
涉及到temp词库.ini的地方，在相应的自已的目录下加个就好了. 同求,多年没来，程序遗忘 收藏学习了！ 感谢大佬分享
页:
[1]