本帖最后由 77077 于 2014-7-9 10:59 编辑
我的函数库.lsp
网友答:
修改了AutoCAD2021运行的问题

网友答: 本帖最后由 mituzhe 于 2023-8-30 22:42 编辑
我找到问题了, 楼里给的代码, 判断lispsys只考虑到了 0 和 1, 我设置的是2网友答: 本帖最后由 77077 于 2014-7-9 10:56 编辑
多谢各位高手指点,程序完成,贴上源码!
使用说明:
1.本人也是新手,还在收集代码中,所以特写了此程序,方便搜索自己收集的函数.
2.务必将代码中"D:\\XX工具箱\\我的函数库.lsp" 修改为自己的函数所在位置.
3. 只管在"我的函数库.lsp "文件中按格式添加函数即可,无需另外编写索引什么的.添加函数的时候,务必在函数的前两行写入";[功能]xxxxxxxxx ;[用法]xxxxxxxxxxxxx"以便搜索.
网友答:
网友答: 点确定后应该直接复制到剪切板网友答: 这样查找自己的函数就放便多了网友答:
网友答:
网友答:
为什么沙发层函数内容是空的???网友答:
这只是一个例子,函数根据需要自己收集,按照格式填入.网友答: 这个方便实用。
我的函数库.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(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: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(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 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)))
- )

- ;;;======相关函数===========*
- ;读取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
为什么沙发层函数内容是空的???
这只是一个例子,函数根据需要自己收集,按照格式填入.网友答: 这个方便实用。