Lisp转换Html ☆[七月·信] 修改版

elitefish · 发表于 2017-1-5 10:55:04

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

效果如本帖，可以将代码复制到论坛中
LISP2HTML.lsp

序号

代码

001.
002.
003.
004.
005.
006.
007.
008.
009.
010.
011.
012.
013.
014.
015.
016.
017.
018.
019.
020.
021.
022.
023.
024.
025.
026.
027.
028.
029.
030.
031.
032.
033.
034.
035.
036.
037.
038.
039.
040.
041.
042.
043.
044.
045.
046.
047.
048.
049.
050.
051.
052.
053.
054.
055.
056.
057.
058.
059.
060.
061.
062.
063.
064.
065.
066.
067.
068.
069.
070.
071.
072.
073.
074.
075.
076.
077.
078.
079.
080.
081.
082.
083.
084.
085.
086.
087.
088.
089.
090.
091.
092.
093.
094.
095.
096.
097.
098.
099.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
377.
378.
379.
380.
381.
382.
383.
384.
385.
386.
387.
388.
389.
390.
391.
392.
393.
394.
395.
396.
397.
398.
399.
400.
401.
402.
403.
404.
405.
406.
407.
408.
409.
410.
411.
412.
413.
414.
415.
416.
417.
418.
419.
420.
421.
422.
423.
424.
425.
426.
427.
428.
429.
430.
431.
432.
433.
434.
435.
436.
437.
438.
439.
440.
441.
442.
443.
444.
445.
446.
447.
448.
449.
450.
451.
452.
453.
454.
455.
456.
457.
458.
459.
460.
461.
462.
463.
464.
465.
466.
467.
468.
469.
470.
471.
472.
473.
474.
475.
476.
477.
478.
479.
480.
481.
482.
483.
484.
485.
486.
487.
488.
489.
490.
491.
492.
493.
494.
495.
496.
497.
498.
499.
500.
501.
502.
503.
504.
505.
506.
507.
508.
509.
510.
511.
512.
513.
514.
515.
516.
517.
518.
519.
520.
521.
522.
523.
524.
525.
526.
527.
528.
529.
530.
531.
532.
533.
534.
535.
536.
537.
538.
539.
540.
541.
542.
543.
544.
545.
546.
547.
548.
549.
550.
551.
552.
553.
554.
555.
556.
557.
558.
559.
560.
561.
562.
563.
564.
565.
566.
567.
568.
569.
570.
571.
572.
573.
574.
575.
576.
577.
578.
579.
580.
581.
582.
583.
584.
585.
586.
587.
588.
589.
590.
591.
592.
593.
594.
595.
596.
597.
598.
599.
600.
601.
602.
603.
604.
605.
606.
607.
608.
609.
610.
611.
612.
613.
614.
615.
616.
617.
618.
619.
620.
621.
622.
623.
624.
625.
626.
627.
628.
629.
630.
631.
632.
633.
634.
635.
636.
637.
638.
639.
640.
641.
642.
643.
644.
645.
646.
647.
648.
649.
650.
651.
652.
653.
654.

;| Lisp转换Html ☆[七月·信] 修改版
改进信息：
1.原版程序复制到论坛上可能会出现行合并的问题，现在应该不会了
2.原版程序行号会影响复制，现在复制可以避开行号了
3.原版程序对仅对特定开头的函数进行超链接定位，现在对所有的函数都进行了超链接
4.增加批量处理
|;

;;; ==================================
;;; |　 LISP文件转换成HTML文件程序 |
;;; | ★[七月·信]修改版★ |
;;; | [[晓东论坛]] |
;;; | [[同是土木人论坛]] |
;;; | [[它山之石图形工作室]图形工作室] |
;;; | [七月·信]修改版 |
;;; ==================================

;|
1、此程序仅作为一种应用上的参考，更多功能请自
　行定制或关注作者发布的应用程序。
2、程序主框架来自于[晓东论坛]，原作者为snoopychen，
　参考了zml84的一小部分代码（html文件头部）。
3、原程序未对行内注释进行处理，增加此功能。
4、有特殊前缀的自定义函数颜色设定为特殊着色，
　主要用来与内部函数进行区分。
5、增加链接跳转功能，文件中的外部链接会指向特定的网页，
　内部链接会指向子函数的定义处。
6、增加了行号，方便阅读。缩进好象变得有问题，待查。
7、原程序需手工输入目录，修改为对话框选择的方式。
8、原程序为将整个目录（含子目录）下的LISP文件全部转换，
　增加了只转换一个文件的命令。
9、对原程序增加了部分简单的注释说明，不一定正确。
10、增加了个显示程序正在运行的小把戏，纯属好玩而已。
11、将LISP转换为HTML方便网络发布及程序的管理。
　　目前还有些想法没有实现，慢慢研究。
|;

;;;命令一，仅转换选择的一个LSP文件
(defun C:LISP2HTML (/ file)
 (princ
"\nLISP2HTML转换器 ★[七月·信]★修改版 ver 1.0 原作者：[它山之石图形工作室]"
 )
 (setq file (getfiled "Select Lisp File" (getvar "dwgprefix") "lsp" 0))
 (setq file (EF_Lisp2Html:Lisp->Html file))
 (startapp "explorer" file)
 (princ)
) ;_ 结束defun

;;;命令二，转换选择的目录下（包括子目录）的所有LSP文件
(defun C:LISPS2HTML (/ direc directree x y direcfile)
 (setq direc (EF_Lisp2Html:GetDir))
 (setq directree (EF_Lisp2Html:GetSubFolders direc))
 (foreach x directree
(setq direcfile (EF_Lisp2Html:GetOnlyFiles x))
(foreach y direcfile
 (if (= (vl-filename-extension y) ".lsp")
(EF_Lisp2Html:Lisp->Html y)
 ) ;_ 结束if
) ;_ 结束foreach
 ) ;_ 结束foreach
 (princ
"\n*** LISP文件转换为HTML文件软件 [七月·信]修改版 <原作者：[它山之石图形工作室]> ***"
 )
 (princ "\n [[七月·信]]修改")
 (princ)
) ;_ 结束defun

 ;自动将指定字符串替换为超链接
(defun EF_Lisp2Html:AddHref (str / lstTrans)
 (setq lstTrans
 '(("[晓东论坛]"
.
 "<a href=\"http://www.xdcad.net\" target=\"_blank\">[[晓东论坛]]</a>"
 )
 ("[同是土木人论坛]"
.
 "<a href=\"http://www.tstmr.com\" target=\"_blank\">[[同是土木人论坛]]</a>"
 )
 ("[它山之石图形工作室]"
.
 "<a href=\"http://StoneDWG.ys168.com\" target=\"_blank\">[[它山之石图形工作室]图形工作室]</a>"
 )
 ("[七月·信]"
.
 "<a href=\"http://elitefish.ys168.com\" target=\"_blank\">[[七月·信]]</a>"
 )
 ("[信·CAD]"
.
 "<a href=\"http://elitefish.ys168.com\" target=\"_blank\">[[信·CAD]]</a>"
 )
 )
 )
 (foreach e lstTrans
(setq str (vl-string-subst (cdr e) (car e) str))
 )
 str
)

;;;子函数，定义程序进度条的显示
(defun EF_Lisp2Html:Spinner ( /)
 (if
 (not #spin)
 (setq #spin "-")
 ) ;_ 结束if
 (cond
((equal #spin "-") (setq #spin "\\"))
((equal #spin "\\") (setq #spin "|"))
((equal #spin "|") (setq #spin "/"))
(T (setq #spin "-"))
 ) ;_ 结束cond
 (princ (strcat (chr 8) #spin))
 (princ)
) ;_ 结束defun

;;子函数，只得到一个目录下的所有文件
(defun EF_Lisp2Html:GetOnlyFiles (path / lst res)
 (setq lst (vl-directory-files path))
 (setq lst (mapcar
 '(lambda (x)
 (strcat path "\\" x)
 ) ;_ 结束lambda
 lst
 ) ;_ 结束mapcar
 ) ;_ 结束setq
 (foreach x lst
(if (not (vl-file-directory-p x))
 (setq res (append
 res
 (list x)
 ) ;_ 结束append
 ) ;_ 结束setq
) ;_ 结束if
 ) ;_ 结束foreach
 res
) ;_ 结束defun

;;子函数，得到一个目录下的所有子目录
;;返回一个列表，如：("E:\\TEST1" "E:\\TEST1\\TEST2")
(defun EF_Lisp2Html:GetSubFolders
 (Path / Folders EF_Lisp2Html:GetSubFolders@Dirs)
 (defun EF_Lisp2Html:GetSubFolders@Dirs (Path / Dir Dirs)
(and
 (= (type Path) 'STR)
 (if (wcmatch Path ",*/,*\\")
(setq Dir Path)
(setq Dir (strcat Path "\\"))
 ) ;_ 结束if
 (setq Dirs (vl-directory-files Dir "*.*" -1))
 (setq Folders (cons Path Folders))
 (setq Dirs (vl-remove-if
 '(lambda (x)
 (vl-position x '("." ".."))
 ) ;_ 结束lambda
 Dirs
 ) ;_ 结束vl-remove-if
 ) ;_ 结束setq
 (mapcar
'EF_Lisp2Html:GetSubFolders@Dirs
(mapcar
 '(lambda (x)
 (strcat Dir x)
 ) ;_ 结束lambda
 Dirs
) ;_ 结束mapcar
 ) ;_ 结束mapcar
) ;_ 结束and
 ) ;_ 结束defun
 (EF_Lisp2Html:GetSubFolders@Dirs Path)
 (reverse Folders)
) ;_ 结束defun

 ;将字符串修正为指定长度(左侧加空格)
(defun EF_Lisp2Html:FixNum (str ;字符串
 iMax ;字符
 / iLen i strList)
 (setq iLen (strlen str))
 (if (> iLen iMax)
(progn
 (setq strList (vl-string->list str))
 (setq i 0)
 (repeat iMax
(if (> (car strList) 128)
 (setq i (1+ i))
)
(setq strList (cdr strList))
 )
 (if (= (rem i 2) 1)
(setq str (substr str 1 (1- iMax)))
(setq str (substr str 1 iMax))
 )
)
(repeat (- iMax iLen) (setq str (strcat "0" str)))
 )
 (strcat str ".")
)

 ;计算正整数的数位
(defun EF_Lisp2Html:NumBit (iNum / i)
 (setq i 1)
 (while (> (setq iNum (/ iNum 10)) 0)
(setq i (1+ i))
 )
 i
)

 ;获取单个字符(中文为双字节)
(defun EF_Lisp2Html:GetChar (str i)
 (if (> (ascii (substr str i 1)) 128)
(substr str i 2)
(substr str i 1)
 )
)

;;子函数
;;利用WSH得到目录，返回如："E;\\TEST"
(defun EF_Lisp2Html:GetDir (/ catchit msg path rtn shfolder winshell)
 (if (null MSG)
(setq MSG "请选择文件夹（LISP->HTML）")
 ) ;_ 结束if
 (if (setq winshell (vlax-create-object "Shell.Application"))
(progn
 (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)
 catchit (vl-catch-all-apply
 '(lambda ()
 (setq shFolder (vlax-get-property shFolder 'self))
 (setq path (vlax-get-property shFolder 'path))
 ) ;_ 结束lambda
 ) ;_ 结束vl-catch-all-apply
 ) ;_ 结束setq
 (vlax-release-object shFolder)
 (vlax-release-object winshell)
 (if (vl-catch-all-error-p catchit)
(setq rtn nil)
(setq rtn path)
 ) ;_ 结束if
) ;_ 结束progn
 ) ;_ 结束if
 rtn
) ;_ 结束defun

;;子函数
(defun EF_Lisp2Html:Format (str)
 (setq
;str (vl-string-subst "<" "<" str)
str (vl-string-subst "&" "&" str)
str (vl-string-subst " " " " str)
str (vl-string-subst " " "\t" str)
 ) ;_ 结束vl-string-subst
) ;_ 结束defun

 ;将字符串字符串以给定 Key 分解成
 ;例：(EF:String->list "a,b,c" ",") →("a" "b" "c")
(defun EF_Lisp2Html:String->list
 (sSource sDelimiter / lenSource lenDelimiter iPos lstResult)
 (if (= sDelimiter "")
(progn (princ "EF:String->list 分割参数不能为空字符\"\"")
 (exit)
)
 )
 (setq
lenSource (strlen sSource)
lenDelimiter (strlen sDelimiter)
 )
 (while (setq iPos (vl-string-search sDelimiter sSource))
(setq
 lstResult (cons (substr sSource 1 iPos) lstResult)
 sSource (substr sSource (+ 1 iPos lenDelimiter))
)
 )
 (reverse (cons sSource lstResult))
) ;_ end EF:String->list

;将字符串列表以给定字符串连接
;例：(EF:List->string ("a" "b" "c") ",") →"a,b,c"
(defun EF_Lisp2Html:List->String (lstString Delimiter / str return)
 (setq return (car lstString)
lstString (cdr lstString)
 )
 (foreach str lstString
(setq return (strcat return Delimiter str))
 ) ;_ end of foreach
 return
) ;end EF:List->string

 ;将字符串中所有目标字符替换为指定字符串
 ;sNew 用于替换的字符串
 ;sOld 将被全部替换的字符串
 ;sSource 源字符串
(defun EF_Lisp2Html:String-Replace (sNew sOld sSource /)
 (EF_Lisp2Html:List->String
(EF_Lisp2Html:String->List sSource sOld)
sNew
 )
)

(defun EF_Lisp2Html:Format2 (str)
 (setq str (EF_Lisp2Html:String-Replace "&" "&" str))
 (setq str (EF_Lisp2Html:String-Replace "<" "<" str))
 (setq str (EF_Lisp2Html:String-Replace " " " " str))
 (setq str (EF_Lisp2Html:String-Replace "<" "<" str))
 ;(while (/= str (setq str (vl-string-subst "&" "&" str))))
 (setq str (EF_Lisp2Html:String-Replace " " " " str))
 (setq str (EF_Lisp2Html:String-Replace
 " "
 "\t"
 str
 )
 )
)

;;主函数
(defun EF_Lisp2Html:Lisp->Html (file / No rf
 strNum wf t1 str
 char i f argument
 strtest hnzhsh-s hnzhsh-e strr
 str_stonedwg str_tstmr
 str_xd word str1 str2
 lstFun
 )
 (princ (strcat "\n" file))
 (princ "\n正在转换成HTML文件，请稍等... ")
 ;;打开准备读写的文件
 (setq lstFun (EF_Lisp2Html:getFunList file))
 (setq rf (open file "r")
wf (open (strcat (vl-filename-directory file)
 "/"
 (vl-filename-base file)
 ".html"
 ) ;_ 结束strcat
 "w"
 ) ;_ 结束open
 ) ;_ 结束setq

 ;;初始化行号
 (setq No 1)
 ;;以下逐行处理
 (setq str1 "")
 (while (setq t1 (read-line rf))
(princ "\n")
(princ t1)
(setq str ""
 No (1+ No)
 i 1
) ;_ 结束setq
(while (<= i (strlen t1))
 (setq word "")
 ;;以下得到一个单词
 (while (not (member (setq char (EF_Lisp2Html:GetChar t1 i))
 '("" " " ";" "(" ")" "\"" "\t")
 ) ;_ 结束member
 ) ;_ 结束not
;(EF_Lisp2Html:Spinner)
(setq word (strcat word char)
 i (+ i (strlen char))
) ;_ 结束setq
 ) ;_ 结束while
 ;;如果为空行
 (if (= word "")
(setq word char
 i (+ i (strlen char))
) ;_ 结束setq
 ) ;_ 结束if

 (if (or strtest (= word ";"))
;;如果是注释
;;20070620实际上需要处理行间注释
(progn
 ;;20070621解决行间注释不在一行内的情况
 (if strtest
 (if (setq hnzhsh-e (vl-string-search "|;" t1))
 (setq strr (substr t1 1 (+ 2 hnzhsh-e))
 i (+ hnzhsh-e 3)
 strtest nil
 ) ;_ 结束setq
 (setq strr t1
 i (1+ (strlen t1))
 ) ;_ 结束setq
 ) ;_ 结束if

 ;;20070621解决行间注释在一行内的情况
 (if (setq hnzhsh-s (vl-string-search ";|" t1))
 (if (setq hnzhsh-e (vl-string-search "|;" t1))
 (setq strr (substr t1
 (+ hnzhsh-s 1)
 (+ 2 (- hnzhsh-e hnzhsh-s))
 ) ;_ 结束substr
 i (+ hnzhsh-e 3)
 ) ;_ 结束setq
 (setq strr (substr t1 (+ hnzhsh-s 1))
 i (1+ (strlen t1))
 strtest T
 ) ;_ 结束setq
 ) ;_ 结束if
 (setq strr (substr t1 (1- i))
 i (1+ (strlen t1))
 ) ;_ 结束setq
 ) ;_ 结束if
 ) ;_ 结束if
 (setq str
 (strcat
 str
 ""
 (EF_Lisp2Html:Format strr)
 ""
 ) ;_ 结束strcat
 ) ;_ 结束setq
) ;_ 结束progn
;;如果不是注释

 ; (if (= No 88) (princ no))
(cond
 ((member word '("(" ")"))
 ;;★★如果是括号
 (setq str (strcat str "")
 i (1- i)
 ) ;_ 结束setq
 ;;继续处理括号
 (while (member (setq char (EF_Lisp2Html:GetChar t1 i))
 '("(" ")")
 ) ;_ 结束member
 (setq str (strcat str char)
 i (+ i (strlen char))
 ) ;_ 结束setq
 ) ;_ 结束while
 (setq str (strcat str "")
 f (= (substr t1 (1- i) 1) "(")
 ) ;_ 结束setq
 )
 ;;★★如果是引号（字符串）

 ((= word "\"")
 (setq str (strcat str "" word))
 (setq str2 "")
 (while (and (/= (setq char (EF_Lisp2Html:GetChar t1 i)) "") ;_ 结束/=
 (or (/= char "\"")
 (and (> i 1)
 (= (substr t1 (1- i) 1) "\\")
 (or
 (= i 2)
 (/= (substr t1 (- i 2) 1) "\\")
 ) ;_ 结束or
 ) ;_ 结束and
 ) ;_ 结束or
 ) ;_ 结束and
 (setq i (+ i (strlen char))
 str2 (strcat str2 char)
 ; (EF_Lisp2Html:Format char))
 ) ;_ 结束setq
 ) ;_ 结束while
 ;(setq str1 (strcat str (

 (setq str2 (EF_Lisp2Html:Format2 str2))
 ;对引号类特殊符号处理

 (setq str (strcat str str2 char "")
 i (1+ i)
 ) ;_ 结束setq
 )
 ;;★★
 ((= word "'")
 (setq str (strcat str "'"))
 )
 ;;★★
 ((= word "/")
 (setq str (strcat str "/")
 argument nil
 f nil
 ) ;_ 结束setq
 )
 ;;★★
 ((= word ".")
 (setq str (strcat str word))
 )
 ;;★★如果是整数
 ((numberp (read word))
 (setq str (strcat str "" word "")
 f nil
 ) ;_ 结束setq
 )
 ;;★★如果是左括号之后的字符串
 (f
 (if argument
 ;;★★★如果之前的字符串是"DEFUN"(全局变量)，则为黑色
 (setq str (strcat str (EF_Lisp2Html:Format word))
 argument nil
 f nil
 ) ;_ 结束setq
 ;;★★★如果之前的字符串不是"DEFUN"(函数名)，则为蓝色
 (setq str (if ;(wcmatch (strcase word) "EF_*,EF-*,EF:,7Xin:,7Xin-,7Xin_")
 (member (strcase word) lstFun)
 ;;20070626自定义函数为青色并增加链接跳转到定义处之功能
 ;;因为原程序为读一行处理完接着写入，不方便对全文统一处理加链接
 ;;只能先针对有特定前缀的自定义函数进行链接
 ;;另外如何在函数定义处增加链接回跳到上页链接处有待研究
 ;;可跳转到顶部
 (strcat str
 "<a href=\"#"
 (strcase word)
 "\">"
 ""
 (EF_Lisp2Html:Format word)
 ""
 "</a>"
 ) ;_ 结束strcat
 (strcat str
 ""
 (EF_Lisp2Html:Format word)
 ""
 ) ;_ 结束strcat
 ) ;_ 结束if
 argument (= (strcase word) "DEFUN")
 f nil
 ) ;_ 结束setq
 ) ;_ 结束if
 )
 ;;★★
 (T
 (if (and argument (/= word " ")) ;;★★★20070626 如果之前的字符串是"DEFUN"，则增加标签，为链接作准备
 (setq str (strcat str
 "<a name=\""
 (strcase word)
 "\">"
 (EF_Lisp2Html:Format word)
 "</a>"
 ) ;_ 结束strcat
 ) ;_ 结束setq
 (setq str (strcat str (EF_Lisp2Html:Format word)))
 ) ;_ 结束if
 ) ;_ 结束T
) ;_ 结束cond
 ) ;_ 结束if
) ;_ 结束while

;;此处可以用表来批量处理
;;也可以将论坛网址、程序作者的主页或博客等写在一个文件里
;;或者将收集的程序原下载网址自动转换为链接
;;以下仅为参考
(setq str (EF_Lisp2Html:AddHref str))

(setq str1 (strcat str1 str " "))
 ) ;_ 结束while

 ;;组织序号
 (setq i 0
strNum ""
 )
 (while (< (setq i (1+ i)) NO)
(setq strNum (strcat strNum
 (if (= (rem i 10) 0)
 (strcat ""
 (EF_Lisp2Html:FixNum
 (rtos i 2 0)
 (EF_Lisp2Html:NumBit No)
 )
 " "
 )
 (strcat (EF_Lisp2Html:FixNum
 (rtos i 2 0)
 (EF_Lisp2Html:NumBit No)
 )
 " "
 )
 )
 )
)
 )
 (setq strNum (strcat strNum ""))

 ;写入文件

 ;;★1写入htm文件头部
 (write-line
(STRCAT
 "<Html>\n<Head><Title>"
 FILE
 "</Title></Head>\n<Body>"
 "\n<Center><H2>"
 (VL-FILENAME-BASE FILE)
 (VL-FILENAME-EXTENSION FILE)
 "</H2></Center>"
 "\n"
) ;_ 结束strcat
wf
 ) ;_ 结束write-line

 ;★2正式写入
 (setq str (strcat
 "<table>"
 "<tr><th>序号</th><th align = left>代码</th>"
 "<tr>"
 "<td valign = Top align = right>"
 ""
 "" strNum
 "" ""
 "</td>" "<td valign = Top>"
 ""
 "" str1
 "" ""
 "</td>" "</table>"
 )
 )
 (write-line str wf)
 (write-line "</Body></Html>" wf)
 (close rf)
 (close wf)
 (strcat (vl-filename-directory file)
 "\\"
 (vl-filename-base file)
 ".html"
 )
) ;_ 结束defun

;获取所有自定义函数列表
(defun EF_Lisp2Html:getFunList (sFile / rf t1 str i n char sFun lstFun)
 (setq rf (open sFile "r"))
 (while (setq t1 (read-line rf))
(setq t1 (strcase t1))
(setq t1 (EF_Lisp2Html:String->List t1 "DEFUN"))
(while (cadr t1)
 (if (wcmatch (car t1) "* ,*\t,*(")
(progn
 (setq str (vl-string-left-trim " \t" (cadr t1))
 i 1
 sFun ""
 )
 (while (not (member (setq char (EF_Lisp2Html:GetChar str i))
 '("" " " ";" "(" ")" "\"" "\t")
 )
 )
 (setq sFun (strcat sFun char)
 i (+ i (strlen char))
 )
 )

 (setq lstFun (cons sFun lstFun))
 )
)
 (setq t1 (cdr t1))
 )
)
 (close rf)
 lstFun
 )

marting · 发表于 2017-1-5 11:06:26

谢谢分享，要是能在表格上面加个拷贝代码到剪切板就更好了，能实现吗？

elitefish · 发表于 2017-1-5 11:15:34

marting 发表于 2017-1-5 11:06

这个应该要JS了，没办法。复制代码可以用 Shift键
在代码最前面鼠标点一下，然后滚动条拉到代码最下按住shift再点下鼠标就可以全选代码了

Lisphk · 发表于 2017-1-5 12:08:12

楼主，你的代码是用VLISP编辑器美化的吗？

elitefish · 发表于 2017-1-5 13:19:26

CAD自带的VLIDE里面写就这样

xpyjc · 发表于 2017-1-5 13:21:40

啥也不说了，感谢楼主分享哇！

sicky111 · 发表于 2017-1-9 22:40:05

昨天刚下，应该和这个是同一个版本吧？

kqqt6236 · 发表于 2017-1-10 17:25:45

这样处理一下，代码漂亮多了。

liunian0524 · 发表于 2017-11-25 09:41:40

感谢分享...

账号		自动登录	找回密码
密码			立即注册

[每日一码] Lisp转换Html ☆[七月·信] 修改版

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分