晓东CAD家园-论坛-A/VLISP-[LISP程序]：lsp文件转换为HTM（按照语法着色）-为了发帖更好看，这是我啃了一个星期的HTM语法，用lisp语言写的一个小程序。其功能是将lsp文件转换成htm语言格式显示，转换后保持了vlisp编辑器默认的语法着色。转换后 ...

zml84 发表于 2007-5-28 20:31:19

[LISP程序]：lsp文件转换为HTM（按照语法着色）

为了发帖更好看，这是我啃了一个星期的HTM语法，用lisp语言写的一个小程序。
其功能是将lsp文件转换成htm语言格式显示，转换后保持了vlisp编辑器默认的语法着色。
 
转换后的效果如下所示：

<center><h1>批量定义命令示例.LSP</h1></center>

<hr><pre>;;; eval函数示例------定义以表中元素为名称的命令
;;;日期：zml84 于 2007-05-24
;;;============================================================
;;;功能：定义系列命令，用于标注管径
(defun C:TT (/ LST I A B)
(setvar "CMDECHO" 0)
(setq LST '(15 20 25 32 40 50 70 80 100 125 150 200 250 300))
(princ "\n定义命令")
(foreach I LST
(setq A (itoa I)
 B (list
 'defun
 (read (strcat "C:" A))
 (list '/)
 (list 'if
 (list 'setq 'PT (list 'getpoint "\n插入点:"))
 (list 'command "_.text" 'PT 20 0 (strcat "DN" A))
 )
 (list 'princ)
)
)
(eval B)
(princ (strcat "" A))
) ;_结束 foreach
(princ "完成！")
(princ)
) ;_结束 defun
;;;============================================================
;|;;后话：看eval的功能说明是：返回一个AutoLISP表达式的求值结果。
 但每个表达式均返回结果，从这方面去想，这个函数似乎无多大用处；
 而事实上，通过灵活的组织其参数就可以达到意想不到的完美效果。
 上面的代码就是一个经典的应用。
;;|;
</pre>

更多效果见：http://zml84.blog.sohu.com/entry/3933137/

animal212 发表于 2007-5-28 20:59:29

方便交流用啊支持

highflybird 发表于 2007-5-28 21:38:19

很好的一个程序，但是现在网站不能上传附件，你的附件下载不了，如果能贴源码的话贴源码吧，要不就转一个能下载的网址。

t4y6 发表于 2007-5-29 08:51:29

这个好用吗？

zml84 发表于 2007-5-29 08:53:55

1楼附件不能下载，请到 ftp://kilu.net/%D7%CA%C1%CF/ 下载 lsp_TO_htm.rar
 
已在网易土木注册的兄弟，请到http://co.163.com/forum/content/1783_754875_1.htm

fools 发表于 2007-5-29 09:28:42

很实用的程序,直接收藏!

snoopychen 发表于 2007-5-29 09:37:30

那我也来凑热闹：）

下面这个是我1年多前下载的一个lsp2html代码的修改

原帖在此
http://www.xdcad.net/forum/showthread.php?threadid=542615

后来为了制作收集lsp的chm代码，修改为如下功能：某目录下递归子目录的所有lsp文件转为html代码

lsp2html的原作者一直不知道是谁，不好意思
我的修改主要是用了John F. Uhden, Cadlantic的目录树函数，将c:\a目录下的lsp代码进行颜色修改

命令:test
做法:将需要转换的lsp文件放到c:\a目录下（也可以自定义），可以多层子目录
缺陷:大部分的lsp代码可以顺利转换，有很少一部分会出错，之后的lsp不再转换，所以我现在的是先格式化代码，再进行转换，就没有问题

googlepages暂时不能访问，放在这里

http://qjchen.blogbus.com/logs/5769520.html

http://qjchen.googlepages.com/lsp2html.html

zml84 发表于 2007-5-29 09:50:43

大家对这个问题都这么感兴趣，我也不好吝啬啊，将1楼的源码帖于下。
目前的问题是，这个东东还不是太完善，表现在对包含htm代码的LISP文件不能正确转换，真是医者不自医。
希望大家共同努力，将这个功能完善。可能的话，将其思想放入本论坛代码解析显示中，以方便更多的人。

<CENTER><H1>lsp_TO_htm.LSP</H1></CENTER>
<SCRIPT LANGUAGE="JavaScript">document.write("最后修改时间: " + document.lastModified)
</SCRIPT>
<HR SIZE=5><PRE>;|;=====================================================================
 功能：将LSP文件转换成htm文件 
 按照语法着色，以便于在网页上发布。 
 日期； zml84 于 2007-05-08 
|;
;|;====================================================================
;;全局变量：颜色 
 0 "#FF0000" 红色括号 
 1 "#0000FF" 蓝色内部函数、受保护的符号 
 2 "#FF00FF" 洋红色字符串 
 3 "#CCCCCC" 灰色注释背景 
 4 "#990099" 黑红色注释 
 5 "#009999" 墨绿色实数 
 6 "#009900" 绿色整数 
 7 "#990000" 褐色单引号、单独点 
|;
(setq LSP2HTM-COL
'("#FF0000" "#0000FF" "#FF00FF" "#CCCCCC"
 "#990099" "#009999" "#009900" "#990000"
 )
)
;;;=====================================================================
;;全局变量：系统保留字
(setq LSP2HTM-BLZ
'("pi" "t" "nil" "+" "-"
 "1+" "1-" "*" "/" "rem"
 "gcd" "max" "exp" "expt" "log"
 "sqrt" "abs" "minusp" "zerop" "numberp"
 "float" "fix" "logand" "logior" "lsh"
 "sin" "cos" "atan" "car" "cdr"
 "cadr" "caddr" "last" "nth" "list"
 "append" "cons" "reverse" "assoc" "subst"
 "foreach" "mapcar" "member" "listp" "setq"
 "set" "quote" "eval" "type" "atom"
 "atoms-family " "null" "boundp" "defun"
 "setfunhelp" "apply" "lambda" "trace"
 "untrace" "getint" "getreal" "getstring" "getpoint"
 "getcorner" "getdist" "getangle""getorient "
 "getkword""polar" "distance""angle" "inters"
 "osnap" "command" "trans" "cvunit" "setvar"
 "getvar" "getenv" "setcfg" "getcfg"
 "acad_colordlg" "ver" "graphscr""textscr"
 "textpage""princ" "prin1" "print" "terpri"
 "menucmd" "grvecs" "vports" "ascii" "chr"
 "itoa" "atoi" "atof" "rtos" "distof"
 "angtos" "angtof" "strcat" "substr" "strcase"
 "strlen" "wcmatch" "=" "/=" "<"
 ">" "<=" ">=" "and" "or"
 "not" "if" "progn" "cond" "while"
 "repeat" "findfile""getfiled""open" "close"
 "read" "read-line" "write-line" "read-char"
 "write-char" "ssget" "sslength""ssname"
 "ssadd" "ssdel" "entnext" "entlast"
 "namedobjdict" "handent" "entsel" "entget"
 "entmod" "entupd" "entmake" "tblnext" "tblsearch"
 "grclear" "grtext" "grread" "defun-q"
 )
)
;;;=====================================================================
;;;主程序
(defun C:TT (/ II FILE-LSP FILE-HTM F1 F2 TMP 当前模式 STR STR-TMP STRI
 I J)
(princ "\nlsp-to-htm")
(if (setq FILE-LSP (getfiled "选择要转换的lsp文件"
""
"lsp"
4
 )
)
(progn
 ;;显示提示信息
 (princ (strcat "\n文件: \"" FILE-LSP "\""))
 (princ "\n正在转换...\n")
 (setq II -1)
 ;;★一、打开文件
 ;;读模式打开lsp文件
 (setq F1 (open FILE-LSP "r"))
 ;;写模式打开htm文件
 (setq FILE-HTM (substr
 FILE-LSP
 1
 (- (strlen
 FILE-LSP
 )
 3
 )
 )
 FILE-HTM (strcat FILE-HTM
 "htm"
 )
 F2 (open FILE-HTM "w")
 )
 ;;★二、写入htm文件头部
 (setq TMP
 (strcat
"<HTML>\n<HEAD><TITLE>"
FILE-LSP
"</TITLE></HEAD>\n<BODY >"
"\n<CENTER><H1>"
(last (STR-FG FILE-LSP '("\\")))
"</H1></CENTER>"
"\n<SCRIPT LANGUAGE=\"JavaScript\">document.write"
"(\"最后修改时间: \" + document.lastModified)"
"\n</SCRIPT>"
"\n<HR SIZE=5><PRE>"
 )
 )
 (princ TMP F2)

 ;;★三、处理代码写入
 ;;初始化当前模式
 ;;　　　约定为：0----代码; 1----字符串; 2----注释
 (setq 当前模式 0)
 ;;读取lsp文件，逐行处理
 (while (setq STR (read-line F1))
;;★打印调试信息
;;(princ "\n")
;;(princ str)
;;逐个元素进行处理
(setq LST-TMP
(STR-FG STR
'("(" ")" " " "\t" ";" "|" "\"" "\\" "'")
)
)
(setq I 0)
(while (setq STRI (nth I LST-TMP))
 (cond
;;★3.0代码模式
((= 当前模式 0)
(cond
 ;;圆括号
 ((or (= STRI "(")
 (= STRI ")")
 )
 (setq
 TMP
 (strcat
"
(nth 0
 LSP2HTM-COL
)
"\">"
STRI
""
 )
 )
 (princ TMP F2)
 )


 ;;空格、Tab
 ((or (= STRI " ")
 (= STRI "\t")
 )
 (setq
 TMP
 STRI
 )
 (princ TMP
 F2
 )
 )

 ;;内部函数、受保护的符号
 ((and (= (type STRI) 'STR)
 (or (member
 (strcase STRI t)
 LSP2HTM-BLZ
 )
 (wcmatch
 (strcase STRI t)
 "vl-*"
 )
 (wcmatch
 (strcase STRI t)
 "vlax-*"
 )
 (wcmatch
 (strcase STRI t)
 "vlr-*"
 )
 (and
 (> I 0)
 (= (nth
 (1- I
 )
 LST-TMP
 )
 "("
 )
 (wcmatch
 (strcase
 STRI
 t
 )
 "zml-*"
 )
 )

 )
 )
 (setq
 TMP
 (strcat
"
(nth 1
 LSP2HTM-COL
)
"\">"
STRI
""
 )
 )
 (princ TMP F2)
 )

 ;;单引号 ' 独立点 .
 ((or (= STRI "'")
 (= STRI ".")
 )
 (setq
 TMP
 (strcat
"
(nth 7
 LSP2HTM-COL
)
"\">"
STRI
""
 )
 )
 (princ TMP F2)
 )

 ;;注释 ;
 ((= STRI ";")
 (if (= (nth (1+ I) LST-TMP)
 "|"
 )
 ;;多行注释(例如 ;|)
 (progn
 (setq TMP ";|")
 (setq I (1+ I))
 ;;将模式设置为注释
 (setq 当前模式 2)
 )
 ;;单行注释(例如 ;;;;;; )
 (progn
 (setq TMP "")
 (while
 (setq STRI
 (nth
 I
 LST-TMP
 )
 )
 (setq TMP (strcat
 TMP
 STRI
 )
 I (1+ I)
 )
 )
 ;;将字符串中的htm关键字替换
 (if (or (wcmatch
 TMP
 "*<*"
 )
 (wcmatch
 TMP
 "*>*"
 )
 )
 (setq
 TMP
(STR-TH
 TMP
 '(("<"
"&lt;"
 )
 (">"
"&gt;"
 )
 )
)
 )
 )
 (setq TMP
 (strcat
 "
 (nth 4
LSP2HTM-COL
 )
 ">
 (nth 3
LSP2HTM-COL
 )
 "\">"
 TMP
 ""
 )
 )
 (princ TMP F2)
 )
 )
 )

 ;;字符串
 ((= STRI "\"")
 (setq TMP "\"")
 ;;将模式设置为字符串
 (setq 当前模式 1)
 )

 ;;实数
 ((= (type (read STRI)) 'REAL)
 (setq
 TMP
 (strcat
"
(nth 5
 LSP2HTM-COL
)
"\">"
STRI
""
 )
 )
 (princ TMP F2)
 )

 ;;整数
 ((= (type (read STRI)) 'INT)
 (setq
 TMP
 (strcat
"
(nth 6
 LSP2HTM-COL
)
"\">"
STRI
""
 )
 )
 (princ TMP F2)
 )

 ;;截断处理
 (t
 (setq
 TMP
 (strcat
""
STRI
""
 )
 )
 (princ TMP F2)
 )
)
) ;_结束代码模式

;;★3.1字符串模式
((= 当前模式 1)
(cond
 ;;以 & 开头的htm格式符号
 ((wcmatch STRI "&*")
 (setq TMP
 (strcat
 TMP
 "&#38;"
 (substr STRI 2)
 )
 )
 )
 ;;转义字符 \ 
 ((= STRI "\\")
 (setq TMP (strcat
 TMP
 STRI
 (nth (+ I 1)
LST-TMP
 )

)
 I (1+ I)
 )
 )
 ;;字符串结束符 " 
 ((= STRI "\"")
 (setq
 TMP (strcat TMP STRI)
 当前模式 0
 )
 )
 (t
 (setq
 TMP (strcat TMP STRI)
 )
 )
) ;_结束 cond
;;判断是否写入文件
(if (or (= 当前模式 0)
;;本行最后一个
(= I
 (1- (length
 LST-TMP
)
 )
)
 )
 (progn
;;将字符串中的htm关键字替换
(if (or (wcmatch
 TMP
 "*<*"
)
(wcmatch
 TMP
 "*>*"
)
 )
 (setq
TMP
 (STR-TH
TMP
'(("<"
 "&lt;"
 )
 (">"
 "&gt;"
 )
)
 )
 )
)
;;附加上格式信息
(setq TMP
 (strcat
 "
 (nth
 2
 LSP2HTM-COL
 )
 "\">"
 TMP
 ""
 )
)
(princ TMP F2)
(setq TMP "")
 )
) ;_结束写入文件判断
) ;_结束字符串模式

;;★3.2多行注释模式
((= 当前模式 2)
(setq TMP (strcat TMP STRI))

(if (or (= I (1- (length LST-TMP)))
(and (= STRI "|")
 (= (nth (1+ I)
 LST-TMP
)
";"
 )
)
 )
 (progn
;;若遇到注释结束符 |; 则返回代码模式
(if (and (= STRI "|")
 (= (nth (1+ I)
 LST-TMP
 )
 ";"
 )
 )
 (setq TMP (strcat TMP
 ";"
 )
 I (1+ I)
 当前模式 0
 )
)
;;将注释中的htm关键字替换
(if (or (wcmatch
 TMP
 "*&*"
)
(wcmatch
 TMP
 "*<*"
)
(wcmatch
 TMP
 "*>*"
)
 )
 (setq
TMP
 (STR-TH
TMP
'(("&"
 "&amp;"
 )
 ("<"
 "&lt;"
 )
 (">"
 "&gt;"
 )
)
 )
 )
)
(setq TMP
 (strcat
 "
 (nth 4 LSP2HTM-COL)
 ">
 (nth 3 LSP2HTM-COL)
 "\">"
 TMP
 ""
 )
)
(princ TMP F2)
(setq TMP "")
 )
)
) ;_结束注释模式
 ) ;_结束 cond

 (setq I (1+ I))
)
;;显示提示信息
(if (= II 3)
 (setq II 0)
 (setq II (1+ II))
)
(princ (strcat "\r"
 (nth II '("---" " / " " | " " \\ "))
 )
)

(princ "\n" F2)
 ) ;_结束 while

 ;;★四、写入htm文件尾部
 (setq TMP "</PRE></BODY></HTML>")
 (princ TMP F2)
 ;;★五、关闭文件
 (close F2)
 (close F1)
 ;;★六、使用打开htm文档
 (princ "\r>>>成功操作完成!!")
 (princ "\n程序完成日期：zml84 于 2007-05-08\n")
 (startapp "notepad" FILE-HTM)
) ;_结束 progn
) ;_结束 if
(princ)
) ;_结束 defun

;|;=====================================================================
 定义函数：分割字符串 
 参数说明： str---欲分割的字符串 
 lst---分割符表，参数类型：表 
 返回值：分割后的字符串表(包含分隔符) 
 类型：表；原子类型:字符串 
 示例：(str-fg "(200~400)x5" '("(" "~" ")" "x")) 
 返回：("(" "200" "~" "400" ")" "x" "5") 
 (str-fg "(setq a 123)" '("(" ")" " " "'")) 
 返回：("(" "setq" " " "a" " " "123") 
 日　期：zml84 于2007-05-08 
|;
(defun STR-FG
 (STR LST / XX I J STRI TEST01 N NI JG)
(if (or (= STR "")
 (= LST "")
)
(setq JG (list STR))
(progn
 ;;★第一步、计算截取的位置
 (setq XX '()
 I1
 )
 (repeat (strlen STR)
(setq STRI (substr STR I 1)
 J 0
 TEST01 t
)
(while TEST01
 (if (= J (length LST))
(setq TEST01 NIL)
(if (= STRI (nth J LST))
 (setq
XX (cons I XX)
TEST01 NIL
 )
 (setq J (1+ J))
)
 )
) ;_ 结束while
(setq I (1+ I))
 ) ;_ 结束repeat
 ;;★第二步、截取字符串
 (if (= XX NIL)
(setq JG (list STR))
(progn
 ;;将表倒置
 (setq XX (reverse XX))
 ;;下面截取字符串
 (setq JG '()
 N0
 )
 ;;1.判断第一个
 (if (= (car XX) 1)
()
(setq
 JG (cons
 (substr
 STR
 1
 (1- (car XX
 )
 )
 )
 JG
 )
)
 )
 ;;2.中间部分
 (repeat (1- (length XX))
(setq I (nth N XX)
 J (nth (1+ N) XX)
)
(setq
 JG (cons (substr STR
 I
 1
 )
 JG
 )
)
(if (> (- J I) 1)
 (setq
JG (cons (substr
 STR
 (1+ I)
 (- J
I
1
 )
)
JG
 )
 )
)
(setq N (1+ N))
 )
 ;;3.判断最后一个
 (setq JG (cons (substr STR
 (last XX)
 1
 )
 JG
 )
 )
 (if (= (last XX) (strlen STR))
()
(setq JG (cons
 (substr
STR
(1+ (last XX
 )
)
(- (strlen
STR
 )
 (last XX
 )
)
 )
 JG
)
)
 )
 (setq JG (reverse JG))
)
 )
) ;_结束 progn
) ;_结束 if
JG
) ;_ 结束defun

;|;=====================================================================
 定义函数：替换字符串 
 参数说明： str---欲替换的字符串 
 lst---分割符表，参数类型：表 
 返回值：替换后的字符串 
 类型：字符串 
 示例：(str-th "<HTML>" '(("<" "&lt;") (">" "&gt;"))) 
 返回："&lt;HTML&gt;" 
 日期：zml84 于2007-05-08 
|;
(defun STR-TH (STR LST / I A B LEN-A TMP J STRJ)
(if (and STR LST)
(progn
 (setq I 0)
 (repeat (length LST)
(setq A (car (nth I LST))
 LEN-A (strlen A)
 B (cadr (nth I LST))
 TMP ""
)

(if (>= (strlen STR) LEN-A)
 (progn
(setq J 1)
(repeat (- (strlen STR)
 LEN-A
 -1
)
 (setq
STRJ (substr STR
 J
 1
 )
 )
 (if (= STRJ A)
(setq TMP
(strcat TMP
B
)
)
(setq TMP
(strcat
 TMP
 STRJ
)
)
 )
 (setq J (1+ J))
)
 )
)

(setq I (1+ I)
 STR TMP
)
 )
)
) ;_结束 if
STR
) ;_ 结束defun

;;;=====================================================================
;;;加载后的提示信息
(princ "\nlsp转换htm 加载完成!!")
(princ "\n★输入命令TT开始运行\n")
(princ)
</PRE>

nore 发表于 2007-5-29 12:27:11

这个功能好，以后就不用用代码了

它山之石 发表于 2007-5-29 12:49:36

没什么好说的了
斑主你是当定了
呵呵

不过在晓东或明经发代码的话
这个倒不如之类的方便了

用在博客什么的上面不错

P.M.F. 发表于 2007-5-30 14:31:35

太棒了，拿回去研究下先~

dwg001 发表于 2007-6-2 10:36:05

在没安装autocad的电脑上看.lsp的着色显示很不错。

changyq 发表于 2007-6-2 16:15:14

很高兴看到这个帖子。非常感谢热心人的帮助。

xxming 发表于 2007-6-4 08:46:38

能否进行批量转换

zml84 发表于 2007-6-4 09:24:01

最初由 xxming 发布
能否进行批量转换
简单修改即可实现批量转换。
 
方法是：将转换部分定义为函数，文件名称以参数的方式传入。

页: [1] 2

晓东CAD家园-论坛's Archiver

[LISP程序]：lsp文件转换为HTM（按照语法着色）