函数搜索,便于大家收集整理自己的函数库~~~

77077 · 发表于 2014-7-7 17:45:28

本帖最后由 77077 于 2014-7-9 10:59 编辑

我的函数库.lsp

;;;用vlisp程序搜索收集的函数.保存函数时,按照格式保存,以便搜索.
;;;函数库文件格式:
;;;[功能]
;;;[用法]
;;;思路:1.点击搜索后,提取关键词,在函数库文件中搜索含有关键词的行和下一行,组成列表显示到列表框中.
;;; 2.点击函数列表框中的项,分别显示到功能和用法两个文本框中.
;;;=============函数库开始===================
;[功能]entmake直线
;[用法](entmakeline p1 p2)
(defun entmakeline (p1 p2)
(entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2)))
)
;[功能]entmake两顶点多段线（多顶点类似）
;[用法](entmakelwpolyline p1 p2)
(defun entmakelwpolyline (pt1 pt2)
(entmakex
(list '(0 . "lwpolyline")
'(100 . "acdbentity")
'(100 . "acdbpolyline")
(cons 90 2)
(cons 10 pt1)
(cons 10 pt2)
)
)
)
;[功能]entmake点表生成多段线
;[用法](make-lwpolyline ptlst)
(defun make-lwpolyline (lst / pt)
(entmakex
(append
(list '(0 . "lwpolyline")
'(100 . "acdbentity")
'(100 . "acdbpolyline")
(cons 90 (length lst))
)
(mapcar '(lambda (pt) (cons 10 pt)) lst)
)
)
)
;[功能]entmake圆
;[用法](entmakecircle cen r)
(defun entmakecircle (cen r)
(entmakex (list '(0 . "circle") (cons 10 cen) (cons 40 r)))
)
;[功能]entmake圆弧
;[用法](entmakearc pt r ang1 ang2)
(defun entmakearc (pt r ang1 ang2)
(entmakex
(list '(0 . "arc")
(cons 10 pt)
(cons 40 r)
(cons 50 ang1)
(cons 51 ang2)
)
)
)
;[功能]entmake单行文本
;[用法](make-text str pt)
(defun make-text (str pt)
(entmakex
(list '(0 . "text") (cons 1 str) (cons 10 pt) (cons 40 5))
)
)
;[功能]entmake居中单行文字
;[用法](entmaketext pt str textheigh)
(defun entmaketext (pt str textheigh)
(entmakex
(list '(0 . "text")
(cons 1 str)
(cons 10 pt)
(cons 40 textheigh)
(cons 11 pt)
(cons 72 1)
(cons 73 2)
)
)
)
;[功能]entmake多行文本
;[用法](entmakemtext str pt)
(defun entmakemtext (str pt)
(entmakex
(list '(0 . "mtext")
'(100 . "acdbentity")
'(100 . "acdbmtext")
;;'(7 . "standard")
(cons 1 str)
(cons 10 pt)
)
)
)
;[功能]entmake半径标注
;[用法](entmakeradial (getpoint) (getpoint))
(defun entmakeradial (cen p2)
(entmakex
(list '(0 . "dimension")
'(100 . "acdbentity")
'(100 . "acdbdimension")
(cons 10 cen)
'(70 . 36)
'(100 . "acdbradialdimension")
(cons 15 p2)
)
)
)
;[功能]entmake直径标注
;[用法](setq ed (entmakediametric (getpoint)(getpoint)(getpoint)))p1 p2圆上点，txtpt文字放置点
(defun entmakediametric (p1 p2 txtpt)
(entmakex
(list '(0 . "dimension")
'(100 . "acdbentity")
'(100 . "acdbdimension")
(cons 10 p1)
(cons 11 txtpt)
'(70 . 163)
'(100 . "acdbdiametricdimension")
(cons 15 p2)
)
)
)
;[功能]entmake水平标注
;[用法](setq ed (entmakedimensionh p1点 p2点文字放置点))
(defun entmakedimensionh (p1 p2 txtpt)
(entmakex
(list '(0 . "dimension")
'(100 . "acdbentity")
'(100 . "acdbdimension")
(cons 10 txtpt)
'(70 . 32)
'(1 . "")
'(100 . "acdbaligneddimension")
(cons 13 p1)
(cons 14 p2)
'(100 . "acdbrotateddimension")
)
)
)
;[功能]entmake垂直标注
;[用法](entmakedimensionv p1点 p2点文字放置点)
(defun entmakedimensionv (p1 p2 txtpt)
(entmakex
(list '(0 . "dimension")
'(100 . "acdbentity")
'(100 . "acdbdimension")
(cons 10 txtpt)
'(70 . 32)
'(1 . "")
'(100 . "acdbaligneddimension")
(cons 13 p1)
(cons 14 p2)
'(50 . 1.5708)
'(100 . "acdbrotateddimension")
)
)
)
;[功能]entmake倾斜标注
;[用法](entmakealigneddim p1点 p2点文字放置点)
(defun entmakealigneddim (p1 p2 txtpt)
(entmakex
(list '(0 . "dimension")
'(100 . "acdbentity")
'(100 . "acdbdimension")
(cons 10 txtpt)
'(70 . 33)
'(1 . "")
'(100 . "acdbaligneddimension")
(cons 13 p1)
(cons 14 p2)
)
)
)

;;;用vlisp程序搜索收集的函数.保存函数时,按照格式保存,以便搜索. 
;;;函数库文件格式: 
;;;[功能] 
;;;[用法] 
;;;思路:1.点击搜索后,提取关键词,在函数库文件中搜索含有关键词的行和下一行,组成列表显示到列表框中. 
;;;     2.点击函数列表框中的项,分别显示到功能和用法两个文本框中. 
;;;=============函数库开始=================== 
;[功能]entmake直线 
;[用法](entmakeline p1 p2) 
(defun entmakeline (p1 p2) 
  (entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2))) 
) 
;[功能]entmake两顶点多段线（多顶点类似） 
;[用法](entmakelwpolyline p1 p2) 
(defun entmakelwpolyline (pt1 pt2) 
  (entmakex 
    (list '(0 . "lwpolyline") 
   '(100 . "acdbentity") 
   '(100 . "acdbpolyline") 
   (cons 90 2) 
   (cons 10 pt1) 
   (cons 10 pt2) 
    ) 
  ) 
) 
;[功能]entmake点表生成多段线 
;[用法](make-lwpolyline ptlst) 
(defun make-lwpolyline (lst / pt) 
  (entmakex 
    (append 
      (list '(0 . "lwpolyline") 
     '(100 . "acdbentity") 
     '(100 . "acdbpolyline") 
     (cons 90 (length lst)) 
      ) 
      (mapcar '(lambda (pt) (cons 10 pt)) lst) 
    ) 
  ) 
) 
;[功能]entmake圆 
;[用法](entmakecircle cen r) 
(defun entmakecircle (cen r) 
  (entmakex (list '(0 . "circle") (cons 10 cen) (cons 40 r))) 
) 
;[功能]entmake圆弧 
;[用法](entmakearc pt r ang1 ang2) 
(defun entmakearc (pt r ang1 ang2) 
  (entmakex 
    (list '(0 . "arc") 
   (cons 10 pt) 
   (cons 40 r) 
   (cons 50 ang1) 
   (cons 51 ang2) 
    ) 
  ) 
) 
;[功能]entmake单行文本 
;[用法](make-text str pt) 
(defun make-text (str pt) 
  (entmakex 
    (list '(0 . "text") (cons 1 str) (cons 10 pt) (cons 40 5)) 
  ) 
) 
;[功能]entmake居中单行文字 
;[用法](entmaketext pt str textheigh) 
(defun entmaketext (pt str textheigh) 
  (entmakex 
    (list '(0 . "text") 
   (cons 1 str) 
   (cons 10 pt) 
   (cons 40 textheigh) 
   (cons 11 pt) 
   (cons 72 1) 
   (cons 73 2) 
    ) 
  ) 
) 
;[功能]entmake多行文本 
;[用法](entmakemtext str pt) 
(defun entmakemtext (str pt) 
  (entmakex 
    (list '(0 . "mtext") 
   '(100 . "acdbentity") 
   '(100 . "acdbmtext") 
   ;;'(7 . "standard") 
   (cons 1 str) 
   (cons 10 pt) 
    ) 
  ) 
) 
;[功能]entmake半径标注 
;[用法](entmakeradial (getpoint) (getpoint)) 
(defun entmakeradial (cen p2) 
  (entmakex 
    (list '(0 . "dimension") 
   '(100 . "acdbentity") 
   '(100 . "acdbdimension") 
   (cons 10 cen) 
   '(70 . 36) 
   '(100 . "acdbradialdimension") 
   (cons 15 p2) 
    ) 
  ) 
) 
;[功能]entmake直径标注 
;[用法](setq ed (entmakediametric (getpoint)(getpoint)(getpoint)))p1 p2圆上点，txtpt文字放置点 
(defun entmakediametric        (p1 p2 txtpt) 
  (entmakex 
    (list '(0 . "dimension") 
          '(100 . "acdbentity") 
          '(100 . "acdbdimension") 
          (cons 10 p1) 
          (cons 11 txtpt) 
          '(70 . 163) 
          '(100 . "acdbdiametricdimension") 
          (cons 15 p2) 
    ) 
  ) 
) 
 
;[功能]entmake水平标注 
;[用法](setq ed (entmakedimensionh p1点 p2点 文字放置点)) 
(defun entmakedimensionh (p1 p2 txtpt) 
  (entmakex 
    (list '(0 . "dimension") 
          '(100 . "acdbentity") 
          '(100 . "acdbdimension") 
          (cons 10 txtpt) 
          '(70 . 32) 
          '(1 . "") 
          '(100 . "acdbaligneddimension") 
          (cons 13 p1) 
          (cons 14 p2) 
          '(100 . "acdbrotateddimension") 
    ) 
  ) 
) 
 
;[功能]entmake垂直标注 
;[用法](entmakedimensionv p1点 p2点 文字放置点) 
(defun entmakedimensionv (p1 p2 txtpt) 
  (entmakex 
    (list '(0 . "dimension") 
          '(100 . "acdbentity") 
          '(100 . "acdbdimension") 
          (cons 10 txtpt) 
          '(70 . 32) 
          '(1 . "") 
          '(100 . "acdbaligneddimension") 
          (cons 13 p1) 
          (cons 14 p2) 
          '(50 . 1.5708) 
          '(100 . "acdbrotateddimension") 
    ) 
  ) 
) 
 
;[功能]entmake倾斜标注 
;[用法](entmakealigneddim p1点 p2点 文字放置点) 
(defun entmakealigneddim (p1 p2 txtpt) 
  (entmakex 
    (list '(0 . "dimension") 
          '(100 . "acdbentity") 
          '(100 . "acdbdimension") 
          (cons 10 txtpt) 
          '(70 . 33) 
          '(1 . "") 
          '(100 . "acdbaligneddimension") 
          (cons 13 p1) 
          (cons 14 p2) 
    ) 
  ) 
)

edata · 发表于 2023-7-25 18:02:17

修改了AutoCAD2021运行的问题

(defun make-dcl (/ lst_str str file f)
(setq lst_str '(
"hsss:dialog {"
" label = \"函数搜索\" ;"
" :spacer {}"
" :row {"
" :edit_box {"
" key = \"key1\" ;"
" label = \"关键词(&K)\" ;"
" width = 60 ;"
" }"
" :button {"
" key = \"key2\" ;"
" label = \"搜索(&S)\" ;"
" }"
" :button {"
" key = \"key3\" ;"
" label = \"显示全部(&A)\" ;"
" }"
" }"
" :boxed_column {"
" label = \"函数列表(&L)\" ;"
" :list_box {"
" key = \"key4\" ;"
" }"
" }"
" :edit_box {"
" key = \"key5\" ;"
" label = \"功能(&F)\" ;"
" }"
" :edit_box {"
" key = \"key6\" ;"
" label = \"用法(&U)\" ;"
" }"
" :spacer {}"
" :row {"
" ok_cancel;"
" :button {"
" key = \"key7\" ;"
" label = \"执行(&R)\" ;"
" fixed_width = true ;"
" width = 12 ;"
" }"
" }"
"}"
)
)
(setq file (vl-filename-mktemp "DclTemp.dcl"))
(setq f (open file "w"))
(foreach str lst_str
(princ "\n" f)
(princ str f)
)
(close f)
file
)
;读取txt文本文件,按行组成表
(defun xx-txt2lst(files / out)
(setq file (open files "r"))
(setq out '())
(while (setq a (read-line file))
(if (= (substr a 1 2) ";[");只提取";["开头的行.
(setq out (cons a out))
)
)
(close file)
(setq out (reverse out))
)
;填充列表框
(defun fill-list-box (key lst)
(start_list key)
(mapcar 'add_list lst)
(end_list)
)
;;返回关键字所在的字符串表位置
;;code by edata@mjtd
(defun sk_ss_str(str_lst key_str / i lst lst2)
(setq i -1 lst str_lst)
(while (setq a(car lst))
(setq lst(cdr lst) i (1+ i))
(if(wcmatch a (strcat "*" key_str "*"))
(setq lst2(cons i lst2)))
)
(if lst2 (setq lst2(reverse lst2)))
)
;=================程序开始========================
(defun C:HSSS( / lst lst1 lst2 lstx1 lstx2 dcl_file)
(setq f(open "D:\\XX工具箱\\我的函数库.lsp" "r"))
(if f (progn (and f (close f))(setq sk_path "D:\\XX工具箱\\我的函数库.lsp"))
(or sk_path (setq sk_path(getfiled "选择函数库文件" "c:/" "lsp;dat;txt;*" 8))))
(if sk_path
(progn
(setq lst (xx-txt2lst sk_path)
lst1 (vl-remove-if '(lambda (x) (/= (substr x 1 (if (= (getvar 'lispsys) 1) 5 7)) ";[功能]")) lst)
lst2 (vl-remove-if '(lambda (x) (/= (substr x 1 (if (= (getvar 'lispsys) 1) 5 7)) ";[用法]")) lst)
lst1 (mapcar '(lambda (x) (substr x (if (= (getvar 'lispsys) 1) 6 8))) lst1)
lst2 (mapcar '(lambda (x) (substr x (if (= (getvar 'lispsys) 1) 6 8))) lst2)
lstx1 lst1
lstx2 lst2
)
(setq dcl_id (load_dialog (setq dcl_file (make-dcl))))
(if(findfile dcl_file)(vl-file-delete dcl_file))
(new_dialog "hsss" dcl_id)
(fill-list-box "key4" lstx1)
(action_tile "key2" "(act-key2 lst1 lst2)")
(action_tile "key3" "(act-key3)")
(action_tile "key4" "(act-key4)")
(action_tile "accept" "(act-key5)(done_dialog)")
(action_tile "key7" "(act-key7)(done_dialog)")
(start_dialog)(unload_dialog dcl_id)
)
)
(princ)
)
;============DCL动作=============
(defun act-key2(lst1 lst2 / str)
(setq str (get_tile "key1"))
(if (setq key_ss (sk_ss_str lst1 str))
(progn
(setq i -1 lstx1 '() lstx2 '())
(while(setq a (nth (setq i (1+ i)) key_ss))
(setq lstx1(cons (nth a lst1) lstx1))
(setq lstx2(cons (nth a lst2) lstx2))
)
(if(and lstx1 lstx2)
(progn
(setq lstx1 (reverse lstx1)
lstx2 (reverse lstx2))
(fill-list-box "key4" lstx1)
)
)
)
(fill-list-box "key4" '("Sorry,未找到与描述相符的函数!"))
)
)
;
(defun act-key4( / n)
(setq n (atoi (get_tile "key4")))
(set_tile "key5" (nth n lstx1))
(set_tile "key6" (nth n lstx2))
)
;
(defun act-key3 ()
(setq lstx1 lst1 lstx2 lst2)
(fill-list-box "key4" lst1)
)
;
(defun act-key5 (/ str)
(if (/= (setq str (get_tile "key6")) "")
(sk_SetClipboard str)
)
)
;
(defun act-key7 (/ str)
(if (/= (setq str (get_tile "key6")) "")
(progn
(sk_SetClipboard str)
(if sk_path(load sk_path))
(vla-SendCommand (vla-get-activedocument(vlax-get-acad-object)) (strcat str " "))
)
)
)
(defun sk_SetClipboard(clip / htm Clip_Bord);设置剪切板
(setq htm (vlax-create-object "htmlfile"))
(setq Clip_Bord (Vlax-Get-Property (Vlax-Get htm 'ParentWindow) 'ClipboardData))
(Vlax-Invoke Clip_Bord 'SetData "text" clip)
)

(defun make-dcl  (/ lst_str str file f) 
    (setq lst_str '( 
"hsss:dialog {" 
"    label = \"函数搜索\" ;" 
"    :spacer {}" 
"    :row {" 
"        :edit_box {" 
"            key = \"key1\" ;" 
"            label = \"关键词(&K)\" ;" 
"            width = 60 ;" 
"        }" 
"        :button {" 
"            key = \"key2\" ;" 
"            label = \"搜索(&S)\" ;" 
"        }" 
"        :button {" 
"            key = \"key3\" ;" 
"            label = \"显示全部(&A)\" ;" 
"        }" 
"    }" 
"    :boxed_column {" 
"        label = \"函数列表(&L)\" ;" 
"        :list_box {" 
"            key = \"key4\" ;" 
"        }" 
"    }" 
"    :edit_box {" 
"        key = \"key5\" ;" 
"        label = \"功能(&F)\" ;" 
"    }" 
"    :edit_box {" 
"        key = \"key6\" ;" 
"        label = \"用法(&U)\" ;" 
"    }" 
"    :spacer {}" 
"        :row {" 
"    ok_cancel;" 
"        :button {" 
"            key = \"key7\" ;" 
"            label = \"执行(&R)\" ;" 
"            fixed_width = true ;" 
"            width = 12 ;" 
"        }" 
"        }" 
"}" 
        ) 
    ) 
    (setq file (vl-filename-mktemp "DclTemp.dcl")) 
    (setq f (open file "w")) 
    (foreach str lst_str 
  (princ "\n" f) 
  (princ str f) 
    ) 
    (close f) 
    file 
) 
;读取txt文本文件,按行组成表 
(defun xx-txt2lst(files / out) 
(setq file (open files "r")) 
(setq out '()) 
(while (setq a (read-line file)) 
      (if (= (substr a 1 2) ";[");只提取";["开头的行. 
      (setq out (cons a out)) 
      ) 
  ) 
(close file) 
(setq out (reverse out)) 
) 
;填充列表框 
(defun fill-list-box (key lst) 
     (start_list key) 
     (mapcar 'add_list lst) 
     (end_list) 
) 
;;返回关键字所在的字符串表位置 
;;code by edata@mjtd 
(defun sk_ss_str(str_lst key_str / i lst lst2) 
  (setq i -1 lst str_lst) 
  (while (setq a(car lst)) 
    (setq lst(cdr lst) i (1+ i)) 
    (if(wcmatch a (strcat "*" key_str "*")) 
      (setq lst2(cons  i lst2))) 
    ) 
  (if lst2 (setq lst2(reverse lst2))) 
) 
;=================程序开始======================== 
(defun C:HSSS( / lst  lst1 lst2 lstx1 lstx2 dcl_file) 
  (setq f(open "D:\\XX工具箱\\我的函数库.lsp" "r")) 
  (if f (progn (and f (close f))(setq sk_path  "D:\\XX工具箱\\我的函数库.lsp")) 
    (or sk_path (setq sk_path(getfiled "选择函数库文件" "c:/" "lsp;dat;txt;*" 8)))) 
(if sk_path 
  (progn    
(setq lst  (xx-txt2lst sk_path) 
      lst1  (vl-remove-if '(lambda (x) (/= (substr x 1 (if (= (getvar 'lispsys) 1) 5 7)) ";[功能]")) lst) 
      lst2  (vl-remove-if '(lambda (x) (/= (substr x 1 (if (= (getvar 'lispsys) 1) 5 7)) ";[用法]")) lst) 
      lst1  (mapcar '(lambda (x) (substr x (if (= (getvar 'lispsys) 1) 6 8))) lst1) 
      lst2  (mapcar '(lambda (x) (substr x (if (= (getvar 'lispsys) 1) 6 8))) lst2) 
      lstx1 lst1 
      lstx2 lst2 
      ) 
(setq dcl_id (load_dialog (setq dcl_file (make-dcl)))) 
(if(findfile dcl_file)(vl-file-delete dcl_file)) 
(new_dialog "hsss" dcl_id) 
(fill-list-box "key4" lstx1) 
(action_tile "key2" "(act-key2 lst1 lst2)") 
(action_tile "key3" "(act-key3)") 
(action_tile "key4" "(act-key4)") 
(action_tile "accept" "(act-key5)(done_dialog)") 
(action_tile "key7" "(act-key7)(done_dialog)") 
(start_dialog)(unload_dialog dcl_id) 
) 
  ) 
(princ) 
) 
;============DCL动作============= 
(defun act-key2(lst1 lst2 / str) 
(setq str (get_tile "key1"))    
  (if (setq key_ss (sk_ss_str lst1 str)) 
    (progn 
      (setq i -1 lstx1 '()  lstx2 '()) 
      (while(setq a (nth (setq i (1+ i)) key_ss)) 
        (setq lstx1(cons (nth a lst1) lstx1)) 
        (setq lstx2(cons (nth a lst2) lstx2)) 
        ) 
      (if(and lstx1 lstx2) 
        (progn 
        (setq lstx1 (reverse lstx1) 
              lstx2 (reverse lstx2)) 
        (fill-list-box "key4" lstx1) 
        ) 
        ) 
      ) 
    (fill-list-box "key4" '("Sorry,未找到与描述相符的函数!")) 
    ) 
) 
; 
(defun act-key4( / n) 
(setq n (atoi (get_tile "key4")))      
(set_tile "key5" (nth n lstx1)) 
(set_tile "key6" (nth n lstx2)) 
) 
; 
(defun act-key3 () 
(setq lstx1 lst1 lstx2 lst2) 
(fill-list-box "key4" lst1) 
) 
; 
(defun act-key5        (/ str) 
  (if (/= (setq str (get_tile "key6")) "") 
    (sk_SetClipboard str) 
  ) 
) 
; 
(defun act-key7        (/ str) 
  (if (/= (setq str (get_tile "key6")) "") 
    (progn 
      (sk_SetClipboard str) 
    (if sk_path(load  sk_path)) 
      (vla-SendCommand (vla-get-activedocument(vlax-get-acad-object)) (strcat str " ")) 
       ) 
  ) 
) 
(defun sk_SetClipboard(clip / htm Clip_Bord);设置剪切板 
(setq htm (vlax-create-object "htmlfile")) 
(setq Clip_Bord (Vlax-Get-Property (Vlax-Get htm 'ParentWindow) 'ClipboardData)) 
(Vlax-Invoke Clip_Bord 'SetData "text" clip) 
)

mituzhe · 发表于 2023-8-30 22:40:44

本帖最后由 mituzhe 于 2023-8-30 22:42 编辑

mituzhe 发表于 2023-8-30 19:33
为啥我的没有搜索结果啊,我这函数库格式应该没问题吧.路径也改了的

我找到问题了, 楼里给的代码, 判断lispsys只考虑到了 0 和 1, 我设置的是2

77077 · 发表于 2014-7-7 17:48:21

本帖最后由 77077 于 2014-7-9 10:56 编辑

多谢各位高手指点,程序完成,贴上源码!
使用说明:
1.本人也是新手,还在收集代码中,所以特写了此程序,方便搜索自己收集的函数.
2.务必将代码中"D:\\XX工具箱\\我的函数库.lsp" 修改为自己的函数所在位置.
3. 只管在"我的函数库.lsp "文件中按格式添加函数即可,无需另外编写索引什么的.添加函数的时候,务必在函数的前两行写入";[功能]xxxxxxxxx ;[用法]xxxxxxxxxxxxx"以便搜索.

(defun make-dcl (/ lst_str str file f)
(setq lst_str '(
"hsss:dialog {"
" label = "函数搜索" ;"
" :spacer {}"
" :row {"
" :edit_box {"
" key = "key1" ;"
" label = "关键词" ;"
" width = 60 ;"
" }"
" :button {"
" key = "key2" ;"
" label = "搜索" ;"
" }"
" :button {"
" key = "key3" ;"
" label = "显示全部" ;"
" }"
" }"
" :boxed_column {"
" label = "函数列表" ;"
" :list_box {"
" key = "key4" ;"
" }"
" }"
" :edit_box {"
" key = "key5" ;"
" label = "功能" ;"
" }"
" :edit_box {"
" key = "key6" ;"
" label = "用法" ;"
" }"
" :spacer {}"
" ok_cancel;"
"}"
)
)
(setq file (vl-filename-mktemp "DclTemp.dcl"))
(setq f (open file "w"))
(foreach str lst_str
(princ "\n" f)
(princ str f)
)
(close f)
file
)
;读取txt文本文件,按行组成表
(defun xx-txt2lst(files / out)
(setq file (open files "r"))
(setq out '())
(while (setq a (read-line file))
(if (= (substr a 1 2) ";[");只提取";["开头的行.
(setq out (cons a out))
)
)
(close file)
(setq out (reverse out))
)
;填充列表框
(defun fill-list-box (key lst)
(start_list key)
(mapcar 'add_list lst)
(end_list)
)
;;返回关键字所在的字符串表位置
;;code by edata@mjtd
(defun sk_ss_str(str_lst key_str / i lst lst2)
(setq i -1 lst str_lst)
(while (setq a(car lst))
(setq lst(cdr lst) i (1+ i))
(if(wcmatch a (strcat "*" key_str "*"))
(setq lst2(cons i lst2)))
)
(if lst2 (setq lst2(reverse lst2)))
)
;=================程序开始========================
(defun C:HSSS( / lst lst1 lst2 lstx1 lstx2)
(setq lst (xx-txt2lst "D:\\XX工具箱\\我的函数库.lsp")
lst1 (vl-remove-if '(lambda (x) (/= (substr x 1 7) ";[功能]")) lst)
lst2 (vl-remove-if '(lambda (x) (/= (substr x 1 7) ";[用法]")) lst)
lst1 (mapcar '(lambda (x) (substr x 8)) lst1)
lst2 (mapcar '(lambda (x) (substr x 8)) lst2)
lstx1 lst1
lstx2 lst2
)
(setq dcl_id (load_dialog (make-dcl))) (new_dialog "hsss" dcl_id)
(fill-list-box "key4" lstx1)
(action_tile "key2" "(act-key2 lst1 lst2)")
(action_tile "key3" "(act-key3)")
(action_tile "key4" "(act-key4)")
(start_dialog)(unload_dialog dcl_id)
(princ)
)
;============DCL动作=============
(defun act-key2(lst1 lst2 / str)
(setq str (get_tile "key1"))
(if (setq key_ss (sk_ss_str lst1 str))
(progn
(setq i -1 lstx1 '() lstx2 '())
(while(setq a (nth (setq i (1+ i)) key_ss))
(setq lstx1(cons (nth a lst1) lstx1))
(setq lstx2(cons (nth a lst2) lstx2))
)
(if(and lstx1 lstx2)
(progn
(setq lstx1 (reverse lstx1)
lstx2 (reverse lstx2))
(fill-list-box "key4" lstx1)
)
)
)
(fill-list-box "key4" '("Sorry,未找到与描述相符的函数!"))
)
)
;
(defun act-key4( / n)
(setq n (atoi (get_tile "key4")))
(set_tile "key5" (nth n lstx1))
(set_tile "key6" (nth n lstx2))
)
;
(defun act-key3 ()
(setq lstx1 lst1 lstx2 lst2)
(fill-list-box "key4" lst1)
)

(defun make-dcl  (/ lst_str str file f) 
    (setq lst_str '( 
"hsss:dialog {" 
"    label = "函数搜索" ;" 
"    :spacer {}" 
"    :row {" 
"        :edit_box {" 
"            key = "key1" ;" 
"            label = "关键词" ;" 
"            width = 60 ;" 
"        }" 
"        :button {" 
"            key = "key2" ;" 
"            label = "搜索" ;" 
"        }" 
"        :button {" 
"            key = "key3" ;" 
"            label = "显示全部" ;" 
"        }" 
"    }" 
"    :boxed_column {" 
"        label = "函数列表" ;" 
"        :list_box {" 
"            key = "key4" ;" 
"        }" 
"    }" 
"    :edit_box {" 
"        key = "key5" ;" 
"        label = "功能" ;" 
"    }" 
"    :edit_box {" 
"        key = "key6" ;" 
"        label = "用法" ;" 
"    }" 
"    :spacer {}" 
"    ok_cancel;" 
"}" 
        ) 
    ) 
    (setq file (vl-filename-mktemp "DclTemp.dcl")) 
    (setq f (open file "w")) 
    (foreach str lst_str 
  (princ "\n" f) 
  (princ str f) 
    ) 
    (close f) 
    file 
) 
;读取txt文本文件,按行组成表 
(defun xx-txt2lst(files / out) 
(setq file (open files "r")) 
(setq out '()) 
(while (setq a (read-line file)) 
      (if (= (substr a 1 2) ";[");只提取";["开头的行. 
      (setq out (cons a out)) 
      ) 
  ) 
(close file) 
(setq out (reverse out)) 
) 
;填充列表框 
(defun fill-list-box (key lst) 
     (start_list key) 
     (mapcar 'add_list lst) 
     (end_list) 
) 
;;返回关键字所在的字符串表位置 
;;code by edata@mjtd 
(defun sk_ss_str(str_lst key_str / i lst lst2) 
  (setq i -1 lst str_lst) 
  (while (setq a(car lst)) 
    (setq lst(cdr lst) i (1+ i)) 
    (if(wcmatch a (strcat "*" key_str "*")) 
      (setq lst2(cons  i lst2))) 
    ) 
  (if lst2 (setq lst2(reverse lst2))) 
) 
;=================程序开始======================== 
(defun C:HSSS( / lst  lst1 lst2 lstx1 lstx2) 
(setq lst  (xx-txt2lst "D:\\XX工具箱\\我的函数库.lsp") 
      lst1  (vl-remove-if '(lambda (x) (/= (substr x 1 7) ";[功能]")) lst) 
      lst2  (vl-remove-if '(lambda (x) (/= (substr x 1 7) ";[用法]")) lst) 
      lst1  (mapcar '(lambda (x) (substr x 8)) lst1) 
      lst2  (mapcar '(lambda (x) (substr x 8)) lst2) 
      lstx1 lst1 
      lstx2 lst2 
      ) 
(setq dcl_id (load_dialog (make-dcl))) (new_dialog "hsss" dcl_id) 
(fill-list-box "key4" lstx1) 
(action_tile "key2" "(act-key2 lst1 lst2)") 
(action_tile "key3" "(act-key3)") 
(action_tile "key4" "(act-key4)") 
(start_dialog)(unload_dialog dcl_id) 
(princ) 
) 
;============DCL动作============= 
(defun act-key2(lst1 lst2 / str) 
(setq str (get_tile "key1"))    
  (if (setq key_ss (sk_ss_str lst1 str)) 
    (progn 
      (setq i -1 lstx1 '()  lstx2 '()) 
      (while(setq a (nth (setq i (1+ i)) key_ss)) 
        (setq lstx1(cons (nth a lst1) lstx1)) 
        (setq lstx2(cons (nth a lst2) lstx2)) 
        ) 
      (if(and lstx1 lstx2) 
        (progn 
        (setq lstx1 (reverse lstx1) 
              lstx2 (reverse lstx2)) 
        (fill-list-box "key4" lstx1) 
        ) 
        ) 
      ) 
    (fill-list-box "key4" '("Sorry,未找到与描述相符的函数!")) 
    ) 
) 
; 
(defun act-key4( / n) 
(setq n (atoi (get_tile "key4")))      
(set_tile "key5" (nth n lstx1)) 
(set_tile "key6" (nth n lstx2)) 
) 
; 
(defun act-key3 () 
(setq lstx1 lst1 lstx2 lst2) 
(fill-list-box "key4" lst1) 
)

77077 · 发表于 2014-7-7 17:49:47

xyp1964 · 发表于 2014-7-7 18:07:51

点确定后应该直接复制到剪切板

qyming · 发表于 2014-7-7 21:04:06

这样查找自己的函数就放便多了

edata · 发表于 2014-7-7 22:12:49

(defun act-key2()
(setq key_ss(sk_ss_str lst1 (get_tile "key1")))
(set_tile "key4" (nth (car key_ss) lst1))
(set_tile "key5" (nth (car key_ss) lst2))
)

;;返回关键字所在的字符串表位置2
;;code by edata@mjtd
(defun sk_ss_str(str_lst key_str / i lst lst2)
(setq i -1 lst str_lst)
(while (setq a(car lst))
(setq lst(cdr lst) i (1+ i))
(if(wcmatch a (strcat "*" key_str "*"))
(setq lst2(cons i lst2)))
)
(if lst2 (setq lst2(reverse lst2)))
)

edata · 发表于 2014-7-7 22:35:51

;;;======相关函数===========*
;读取txt文本文件,按行组成表
(defun xx-txt2lst(files / out)
(setq file (open files "r"))
(setq out '())
(while (setq a (read-line file))
(setq out (cons a out))
)
(close file)
(setq out (reverse out))
)
(defun fill-list-box (key lst)
(start_list key)
(mapcar 'add_list lst)
(end_list)
)
;========主程序=============*
(defun C:HSSS()
(setq lst (xx-txt2lst "c:\\我的函数库.lsp");读取lsp文件中的内容
lst1 (vl-remove-if '(lambda (x) (/= (substr x 1 7) ";[功能]")) lst);提取以;[功能]开头的行,保存为lst1
lst2 (vl-remove-if '(lambda (x) (/= (substr x 1 7) ";[用法]")) lst);提取以;[用法]开头的行,保存为lst2
lst1 (mapcar '(lambda (x) (substr x 8)) lst1);返回函数功能列表
lst2 (mapcar '(lambda (x) (substr x 8)) lst2);返回函数用法列表
lstx lst1
lstx1 lst1
lstx2 lst2
)
(setq dcl_id (load_dialog "hsss.dcl"));(make-dcl)))
(new_dialog "hsss" dcl_id)
(fill-list-box "key3" lstx)
(action_tile "key2" "(act-key2 lst1 lst2)")
(action_tile "key3" "(act-key3)")
(start_dialog)(unload_dialog dcl_id)
(princ)
)
(defun act-key3( / n)
(setq n (atoi (get_tile "key3")))
(set_tile "key4" (nth n lstx1))
(set_tile "key5" (nth n lstx2))
)
(defun act-key2(lst1 lst2 / str)
(setq str (get_tile "key1"))
lstx ()
(if (setq key_ss(sk_ss_str lst1 str))
(progn
(setq i -1 lstx1 nil lstx2 nil)
(while(setq a(nth (setq i (1+ i)) key_ss))
(setq lstx1(cons (nth a lst1) lstx1))
(setq lstx2(cons (nth a lst2) lstx2))
)
(if(and lstx1 lstx2)
(progn
(setq lstx1 (reverse lstx1)
lstx2 (reverse lstx2))
(fill-list-box "key3" lstx1)
)
)
)
(fill-list-box "key3" '("未找到与描述相符的函数"))
)
)
;;返回关键字所在的字符串表位置2
;;code by edata@mjtd
(defun sk_ss_str(str_lst key_str / i lst lst2)
(setq i -1 lst str_lst)
(while (setq a(car lst))
(setq lst(cdr lst) i (1+ i))
(if(wcmatch a (strcat "*" key_str "*"))
(setq lst2(cons i lst2)))
)
(if lst2 (setq lst2(reverse lst2)))
)

;;;======相关函数===========* 
;读取txt文本文件,按行组成表 
(defun xx-txt2lst(files / out) 
(setq file (open files "r")) 
(setq out '()) 
(while (setq a (read-line file)) 
      (setq out (cons a out)) 
  ) 
(close file) 
(setq out (reverse out)) 
) 
(defun fill-list-box (key lst) 
     (start_list key) 
     (mapcar 'add_list lst) 
     (end_list) 
) 
;========主程序=============* 
 
(defun C:HSSS() 
(setq lst  (xx-txt2lst "c:\\我的函数库.lsp");读取lsp文件中的内容 
      lst1  (vl-remove-if '(lambda (x) (/= (substr x 1 7) ";[功能]")) lst);提取以;[功能]开头的行,保存为lst1 
      lst2  (vl-remove-if '(lambda (x) (/= (substr x 1 7) ";[用法]")) lst);提取以;[用法]开头的行,保存为lst2 
      lst1  (mapcar '(lambda (x) (substr x 8)) lst1);返回函数功能列表 
      lst2  (mapcar '(lambda (x) (substr x 8)) lst2);返回函数用法列表 
      lstx lst1 
      lstx1 lst1 
      lstx2 lst2 
      ) 
(setq dcl_id (load_dialog "hsss.dcl"));(make-dcl))) 
  (new_dialog "hsss" dcl_id) 
(fill-list-box "key3" lstx) 
  (action_tile "key2" "(act-key2 lst1 lst2)") 
(action_tile "key3" "(act-key3)") 
(start_dialog)(unload_dialog dcl_id) 
(princ) 
) 
(defun act-key3( / n) 
(setq n (atoi (get_tile "key3")))      
(set_tile "key4" (nth n lstx1)) 
(set_tile "key5" (nth n lstx2)) 
) 
 
(defun act-key2(lst1 lst2 / str) 
(setq str (get_tile "key1"))    
      lstx () 
  (if (setq key_ss(sk_ss_str lst1 str)) 
    (progn 
      (setq i -1 lstx1 nil  lstx2 nil) 
      (while(setq a(nth (setq i (1+ i)) key_ss)) 
        (setq lstx1(cons (nth a lst1) lstx1)) 
        (setq lstx2(cons (nth a lst2) lstx2)) 
        ) 
      (if(and lstx1 lstx2) 
        (progn 
        (setq lstx1 (reverse lstx1) 
              lstx2 (reverse lstx2)) 
        (fill-list-box "key3" lstx1) 
        ) 
        ) 
      ) 
    (fill-list-box "key3" '("未找到与描述相符的函数")) 
    ) 
) 
 
;;返回关键字所在的字符串表位置2 
;;code by edata@mjtd 
(defun sk_ss_str(str_lst key_str / i lst lst2) 
  (setq i -1 lst str_lst) 
  (while (setq a(car lst)) 
    (setq lst(cdr lst) i (1+ i)) 
    (if(wcmatch a (strcat "*" key_str "*")) 
      (setq lst2(cons  i lst2))) 
    ) 
  (if lst2 (setq lst2(reverse lst2))) 
    )

机械工程师 · 发表于 2014-7-8 08:23:11

为什么沙发层函数内容是空的？？？

77077 · 发表于 2014-7-8 08:59:59

机械工程师发表于 2014-7-8 08:23
为什么沙发层函数内容是空的？？？

这只是一个例子,函数根据需要自己收集,按照格式填入.

434939575 · 发表于 2014-7-10 15:01:03

这个方便实用。

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

[已解答] 函数搜索,便于大家收集整理自己的函数库~~~

评分

本帖被以下淘专辑推荐:

相关帖子

函数搜索,便于大家收集整理自己的函数库~~~

评分

本帖子中包含更多资源

评分