增加热键 文本框、列表框时ALT+字母键，非文本框、列表框按字母键
友情提示，在列表框中按字母键可以快速找到以该字母为首的函数，输入中文则找到该中文开头的函数。
按确定将复制到剪贴板。
按运行将用法中的语句通过sendcommand执行。如原函数是(entmakeline p1 p2)在用法一栏文本框中输入
(entmakeline (getpoint) (getpoint))可以执行。
(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 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 (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)
)
继续完善。。。。。
edata 发表于 2014-7-15 16:04
增加热键 文本框、列表框时ALT+字母键，非文本框、列表框按字母键
友情提示，在列表框中按字母键可以快速找 ...
怎么回事，出错了
qyming 发表于 2014-7-15 22:11 static/image/common/back.gif
怎么回事，出错了
不知道哪里错了。
应该是这段
(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 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
)
(set
qyming 发表于 2014-7-16 09:48 static/image/common/back.gif
应该是这段
(setq f(open "D:\\XX工具箱\\我的函数库.lsp" "r"))
(if f (progn (and f (close f))(setq s ...
我昨天试用没发现问题
21楼的？还是2楼的？2楼的是没问题
qyming 发表于 2014-7-16 11:12 static/image/common/back.gif
21楼的？还是2楼的？2楼的是没问题
21楼的，挺好用的。
顶起了
顶起 支持!!!