我的技术说明词库

pannelchen · 发表于 2015-1-20 23:22:29

本帖最后由 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))
(while data
(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))
((= k n ) (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 ((= k n ) (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 (open file "r"))
(setq tmplst '())
(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 (open file "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 '<))
)

(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)) 
  (while  data 
      (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)) 
            ((= k  n )   (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 ((= k  n )   (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 (open  file "r")) 
    (setq  tmplst '()) 
     (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 (open  file "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 '<)) 
)

pannelchen · 发表于 2015-1-20 23:30:03

涉及到temp词库.ini的地方，在相应的自已的目录下加个就好了.

ld80721 · 发表于 2016-10-16 21:41:08

同求,多年没来，程序遗忘

趣意人生 · 发表于 2021-3-31 12:35:49

收藏学习了！

magicheno · 发表于 2023-12-19 12:39:05

感谢大佬分享

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

[讨论] 我的技术说明词库

本帖子中包含更多资源

评分

本帖子中包含更多资源

评分