函数搜索,便于大家收集整理自己的函数库~~~
本帖最后由 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)
)
)
)
修改了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(consi lst2)))
)
(if lst2 (setq lst2(reverse lst2)))
)
;=================程序开始========================
(defun C:HSSS( / lstlst1 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(loadsk_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:42 编辑
mituzhe 发表于 2023-8-30 19:33
为啥我的没有搜索结果啊,我这函数库格式应该没问题吧.路径也改了的
我找到问题了, 楼里给的代码, 判断lispsys只考虑到了 0 和 1, 我设置的是2
函数搜索,便于大家收集整理自己的函数库~~~
本帖最后由 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(consi lst2)))
)
(if lst2 (setq lst2(reverse lst2)))
)
;=================程序开始========================
(defun C:HSSS( / lstlst1 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 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(consi 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 nillstx2 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(consi lst2)))
)
(if lst2 (setq lst2(reverse lst2)))
) 为什么沙发层函数内容是空的？？？ 机械工程师 发表于 2014-7-8 08:23 static/image/common/back.gif
为什么沙发层函数内容是空的？？？
这只是一个例子,函数根据需要自己收集,按照格式填入. 这个方便实用。