[原创]：整理lisp变菜单

cy956

这个lsp的功能是收集lsp文件中的外部函数，自动转成菜单的格式，
供lisp写得多或收得多的兄弟们整理方便。
要用到dislib的函数。
要求是lsp文件中命令的注释和(defun c:xx在同一行，如：

(defun c:pzx ()(pzx (* 3 0bl))) ;;;破折线;;;
(defun c:pzx1 ()(pzx 0bl))          ;;;小破折线;;;
(defun c:pzx                 ;;;破折线;;;
  (/ a ava f fa )
  。。。。)
(defun c:pzx         (/ a ava f fa )        ;;;破折线;;;
    。。。。)

运行时可多选文件，然后后会在c:盘建一个临时文件：

[破折线pzx]^c^c(ld c:pzx "FH.lsp");_pzx
[小破折线pzx1]^c^c(ld c:pzx1 "FH.lsp");_pzx1
。。。。

你可以剪贴了放在lsp文件前做总目，也可以
剪贴到菜单中使用。
菜单中的ld函数其实就是load，弟兄们自己调整吧。

2. 
   
3. (defun cy_strbnil_b(b / A IN N STRB0);;空字串表清理;;
   
4.   (setq strb0 '()n(length b)in 0)
   
5.   (repeat n
   
6.     (setq a(nth in b)in(1+ in))
   
7.     (if (/= a "")(setq strb0(append strb0 (list a))))
   
8.   )strb0
   
9. )
   
10. 
    
11. (defun c:hs1 ;;lsp外部函数变菜单;;
    
12.        (/ F1 F2 FLN FLNAM FLNB FLNB1 FLNLSP FLNN IN1 MINLM MNU-STR PATH
    
13.                STR1 STRB STRB1 STRB2 T1 ZSM)
    
14.   (setq        fln    "c:/acadcom.txt"
    
15.         flnlsp (dos_getfilem "选择lsp文件:"
    
16.                  (if path-cb path-cb "E:/")
    
17.                  "LISP Files (*.lsp)|*.LSP")
    
18.         flnn(1- (length flnlsp)) path (car flnlsp)
    
19.         path-cb path
    
20.         flnb(cdr flnlsp) path(car flnlsp)
    
21.         flnb1 (ACAD_STRLSORT flnb)flnb flnb1
    
22.         in1 0 f2 (open fln "w")
    
23.   )
    
24.   (while (setq flnam (nth in1 flnb))
    
25.     (setq flnlsp(strcat path flnam) in1(1+ in1)
    
26.           f1(open flnlsp "r"))
    
27.     (write-line flnlsp f2)
    
28.     (while (setq t1 (read-line f1))
    
29.       (if (= (strcase (substr t1 1 9)) "(DEFUN C:")(progn
    
30.         (setq t1(substr t1 8)
    
31.               strb(strParse t1 ";");;变为表;
    
32.               strb1(cy_strbnil_b strb)
    
33.               str1(car strb1)
    
34.               strb2(strParse str1  " ")
    
35.               minlm(car (cy_strbnil_b strb2))
    
36.               minlm(car (strParse minlm  "(")));;命令名;;
    
37.         (if (nth 1 strb1)
    
38.           (setq zsm(nth 1 strb1))
    
39.           (setq zsm "")
    
40.         );;注释名;;
    
41.         (setq mnu-str(strcat "[" zsm (substr minlm 3)  "]^c^c(ld " minlm
    
42.                              " "" flnam "");_" (substr minlm 3)))
    
43.         (write-line mnu-str f2)
    
44.       ) )
    
45.     )
    
46.     (close f1)
    
47.   )
    
48.   (close f2)
    
49.   (dos_shellexe "notepad.exe" "c:/acadcom.txt")
    
50. )
    
51. 
    
52. (defun strParse        (Str Delimiter / SearchStr StringLen return n char)
    
53. ;;;(StrParse Str Delimiter)  ;Str字符串  Delimiter分隔符
    
54. ;;;将具有分隔符的字符串解析为列表,Delimiter可以多字符
    
55.   (setq SearchStr Str return '()
    
56.         StringLen (strlen SearchStr)
    
57.         strlen-d(strlen Delimiter))
    
58.   (while (> StringLen 0)
    
59.     (setq n 1
    
60.           char (substr SearchStr 1 strlen-d))
    
61.     (while (and (/= char Delimiter) (/= char ""))
    
62.       (setq n (1+ n) char (substr SearchStr n strlen-d))
    
63.     )
    
64.     (setq return (cons (substr SearchStr 1 (1- n)) return)
    
65.           SearchStr (substr SearchStr (+ n strlen-d) StringLen)
    
66.           StringLen (strlen SearchStr))
    
67.   )(reverse return)
    
68. )
    
69. 
    

<br /> (defun cy_strbnil_b(b / A IN N STRB0);;空字串表清理;;<br />   (setq strb0 '()n(length b)in 0)<br />   (repeat n<br />     (setq a(nth in b)in(1+ in))<br />     (if (/= a "")(setq strb0(append strb0 (list a))))<br />   )strb0<br /> )<br /> <br /> (defun c:hs1 ;;lsp外部函数变菜单;;<br />        (/ F1 F2 FLN FLNAM FLNB FLNB1 FLNLSP FLNN IN1 MINLM MNU-STR PATH<br />                STR1 STRB STRB1 STRB2 T1 ZSM)<br />   (setq        fln    "c:/acadcom.txt"<br />         flnlsp (dos_getfilem "选择lsp文件:"<br />                  (if path-cb path-cb "E:/")<br />                  "LISP Files (*.lsp)|*.LSP")<br />         flnn(1- (length flnlsp)) path (car flnlsp)<br />         path-cb path<br />         flnb(cdr flnlsp) path(car flnlsp)<br />         flnb1 (ACAD_STRLSORT flnb)flnb flnb1<br />         in1 0 f2 (open fln "w")<br />   ) <br />   (while (setq flnam (nth in1 flnb))<br />     (setq flnlsp(strcat path flnam) in1(1+ in1)<br />           f1(open flnlsp "r"))<br />     (write-line flnlsp f2)<br />     (while (setq t1 (read-line f1))<br />       (if (= (strcase (substr t1 1 9)) "(DEFUN C:")(progn<br />         (setq t1(substr t1 8)<br />               strb(strParse t1 ";");;变为表;<br />               strb1(cy_strbnil_b strb)<br />               str1(car strb1)<br />               strb2(strParse str1  " ")<br />               minlm(car (cy_strbnil_b strb2))<br />               minlm(car (strParse minlm  "(")));;命令名;;<br />         (if (nth 1 strb1)<br />           (setq zsm(nth 1 strb1))<br />           (setq zsm "")<br />         );;注释名;;<br />         (setq mnu-str(strcat "[" zsm (substr minlm 3)  "]^c^c(ld " minlm<br />                              " "" flnam "");_" (substr minlm 3)))<br />         (write-line mnu-str f2)<br />       ) )<br />     )<br />     (close f1)<br />   )<br />   (close f2)<br />   (dos_shellexe "notepad.exe" "c:/acadcom.txt")<br /> )<br /> <br /> (defun strParse        (Str Delimiter / SearchStr StringLen return n char)<br /> ;;;(StrParse Str Delimiter)  ;Str字符串  Delimiter分隔符<br /> ;;;将具有分隔符的字符串解析为列表,Delimiter可以多字符<br />   (setq SearchStr Str return '()<br />         StringLen (strlen SearchStr)<br />         strlen-d(strlen Delimiter))<br />   (while (> StringLen 0)<br />     (setq n 1<br />           char (substr SearchStr 1 strlen-d))<br />     (while (and (/= char Delimiter) (/= char ""))<br />       (setq n (1+ n) char (substr SearchStr n strlen-d))<br />     )<br />     (setq return (cons (substr SearchStr 1 (1- n)) return)<br />           SearchStr (substr SearchStr (+ n strlen-d) StringLen)<br />           StringLen (strlen SearchStr))<br />   )(reverse return)<br /> )<br /> <br />

丹佛

我怎么运行不了呢，是不是还缺少什么支持函数呢？

cy956

这是一个老程序了，以前的程序注释写得不规范，改过n次，
抄了strParse函数后又改过一次，所以比较拖沓。能用不想再改了。
里面都是老lisp函数了，应该没问题。

你是否没加载doslib5.0以上版本？这里用于选择文件路径。
你如不想加，可以自己改为其他选文件函数，或者
干脆指定一个文件路径.

贴程序最怕找内部函数，在自己的机子上什么都是现成的，
所以往往发现不了。好在是程序论坛，dx们要么提出，
要么稍稍动手改改，问题应该还不大。

雨箭风刀

想法不错