lisp类似常青藤菜单_晓东CAD家园-论坛-A/VLISP-[原创]：整理lisp变菜单-这个lsp的功能是收集lsp文件中的外部函数，自动转成菜单的格式，供lisp写得多或收得多的兄弟们整理方便。...

(defun cy_strbnil_b(b / A IN N STRB0);;空字串表清理;;

(setq strb0 '()n(length b)in 0)

(repeat n

(setq a(nth in b)in(1+ in))

(if (/= a "")(setq strb0(append strb0 (list a))))

)strb0

)

(defun c:hs1 ;;lsp外部函数变菜单;;

(/ F1 F2 FLN FLNAM FLNB FLNB1 FLNLSP FLNN IN1 MINLM MNU-STR PATH

STR1 STRB STRB1 STRB2 T1 ZSM)

(setq        fln    "c:/acadcom.txt"

flnlsp (dos_getfilem "选择lsp文件:"

(if path-cb path-cb "E:/")

"LISP Files (*.lsp)|*.LSP")

flnn(1- (length flnlsp)) path (car flnlsp)

path-cb path

flnb(cdr flnlsp) path(car flnlsp)

flnb1 (ACAD_STRLSORT flnb)flnb flnb1

in1 0 f2 (open fln "w")

)

(while (setq flnam (nth in1 flnb))

(setq flnlsp(strcat path flnam) in1(1+ in1)

f1(open flnlsp "r"))

(write-line flnlsp f2)

(while (setq t1 (read-line f1))

(if (= (strcase (substr t1 1 9)) "(DEFUN C:")(progn

(setq t1(substr t1 8)

strb(strParse t1 ";");;变为表;

strb1(cy_strbnil_b strb)

str1(car strb1)

strb2(strParse str1  " ")

minlm(car (cy_strbnil_b strb2))

minlm(car (strParse minlm  "(")));;命令名;;

(if (nth 1 strb1)

(setq zsm(nth 1 strb1))

(setq zsm "")

);;注释名;;

(setq mnu-str(strcat "[" zsm (substr minlm 3)  "]^c^c(ld " minlm

" "" flnam "");_" (substr minlm 3)))

(write-line mnu-str f2)

) )

)

(close f1)

)

(close f2)

(dos_shellexe "notepad.exe" "c:/acadcom.txt")

)

(defun strParse        (Str Delimiter / SearchStr StringLen return n char)

;;;(StrParse Str Delimiter)  ;Str字符串  Delimiter分隔符

;;;将具有分隔符的字符串解析为列表,Delimiter可以多字符

(setq SearchStr Str return '()

StringLen (strlen SearchStr)

strlen-d(strlen Delimiter))

(while (> StringLen 0)

(setq n 1

char (substr SearchStr 1 strlen-d))

(while (and (/= char Delimiter) (/= char ""))

(setq n (1+ n) char (substr SearchStr n strlen-d))

)

(setq return (cons (substr SearchStr 1 (1- n)) return)

SearchStr (substr SearchStr (+ n strlen-d) StringLen)

StringLen (strlen SearchStr))

)(reverse return)

)