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

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

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

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

×

为了发帖更好看，这是我啃了一个星期的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>

<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暂时不能访问，放在这里

[iframe h=500 w=500]http://qjchen.blogbus.com/logs/5769520.html[/iframe]

[iframe h=1 w=600]http://qjchen.googlepages.com/lsp2html.html[/iframe]

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 '()
I 1
)
(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 '()
N 0
)
;;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>

<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"   "="               "/="           "&lt;" 
           "&gt;"               "&lt;="           "&gt;="               "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 
                         "&lt;HTML&gt;\n&lt;HEAD&gt;&lt;TITLE&gt;" 
                         FILE-LSP 
                         "&lt;/TITLE&gt;&lt;/HEAD&gt;\n&lt;BODY &gt;" 
                         "\n&lt;CENTER&gt;&lt;H1&gt;" 
                         (last (STR-FG FILE-LSP '("\"))) 
                         "&lt;/H1&gt;&lt;/CENTER&gt;" 
                         "\n&lt;SCRIPT LANGUAGE="JavaScript"&gt;document.write" 
                         "("最后修改时间: " + document.lastModified)" 
                         "\n&lt;/SCRIPT&gt;" 
                         "\n&lt;HR SIZE=5&gt;&lt;PRE&gt;" 
                     ) 
            ) 
            (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 
                                         "&lt;FONT face="Fixedsys" COLOR="" 
                                         (nth 0 
                                              LSP2HTM-COL 
                                         ) 
                                         ""&gt;" 
                                         STRI 
                                         "&lt;/FONT&gt;" 
                                     ) 
                              ) 
                              (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 
                                         "&lt;FONT face="Fixedsys" COLOR="" 
                                         (nth 1 
                                              LSP2HTM-COL 
                                         ) 
                                         ""&gt;" 
                                         STRI 
                                         "&lt;/FONT&gt;" 
                                     ) 
                              ) 
                              (princ TMP F2) 
                             ) 
 
                             ;;单引号 ' 独立点 . 
                             ((or (= STRI "'") 
                                  (= STRI ".") 
                              ) 
                              (setq 
                                  TMP 
                                     (strcat 
                                         "&lt;FONT face="Fixedsys" COLOR="" 
                                         (nth 7 
                                              LSP2HTM-COL 
                                         ) 
                                         ""&gt;" 
                                         STRI 
                                         "&lt;/FONT&gt;" 
                                     ) 
                              ) 
                              (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 
                                                  "*&lt;*" 
                                              ) 
                                              (wcmatch 
                                                  TMP 
                                                  "*&gt;*" 
                                              ) 
                                          ) 
                                          (setq 
                                              TMP 
                                                 (STR-TH 
                                                     TMP 
                                                     '(("&lt;" 
                                                        "&#38;lt;" 
                                                       ) 
                                                       ("&gt;" 
                                                        "&#38;gt;" 
                                                       ) 
                                                      ) 
                                                 ) 
                                          ) 
                                      ) 
                                      (setq TMP 
                                               (strcat 
                                                   "&lt;FONT face="Fixedsys" COLOR=" 
                                                   (nth        4 
                                                        LSP2HTM-COL 
                                                   ) 
                                                   "&gt;&lt;SPAN STYLE="BACKGROUND-COLOR: " 
                                                   (nth        3 
                                                        LSP2HTM-COL 
                                                   ) 
                                                   ""&gt;" 
                                                   TMP 
                                                   "&lt;/SPAN&gt;&lt;/FONT&gt;" 
                                               ) 
                                      ) 
                                      (princ TMP F2) 
                                  ) 
                              ) 
                             ) 
 
                             ;;字符串 
                             ((= STRI """) 
                              (setq TMP """) 
                              ;;将模式设置为字符串 
                              (setq 当前模式 1) 
                             ) 
 
                             ;;实数 
                             ((= (type (read STRI)) 'REAL) 
                              (setq 
                                  TMP 
                                     (strcat 
                                         "&lt;FONT face="Fixedsys" COLOR="" 
                                         (nth 5 
                                              LSP2HTM-COL 
                                         ) 
                                         ""&gt;" 
                                         STRI 
                                         "&lt;/FONT&gt;" 
                                     ) 
                              ) 
                              (princ TMP F2) 
                             ) 
 
                             ;;整数 
                             ((= (type (read STRI)) 'INT) 
                              (setq 
                                  TMP 
                                     (strcat 
                                         "&lt;FONT face="Fixedsys" COLOR="" 
                                         (nth 6 
                                              LSP2HTM-COL 
                                         ) 
                                         ""&gt;" 
                                         STRI 
                                         "&lt;/FONT&gt;" 
                                     ) 
                              ) 
                              (princ TMP F2) 
                             ) 
 
                             ;;截断处理 
                             (t 
                              (setq 
                                  TMP 
                                     (strcat 
                                         "&lt;FONT face="Fixedsys"&gt;" 
                                         STRI 
                                         "&lt;/FONT&gt;" 
                                     ) 
                              ) 
                              (princ TMP F2) 
                             ) 
                         ) 
                        ) ;_结束 代码模式 
 
                        ;;★3.1字符串模式 
                        ((= 当前模式 1) 
                         (cond 
                             ;;以 & 开头的htm格式符号 
                             ((wcmatch STRI "&#38;*") 
                              (setq TMP 
                                       (strcat 
                                           TMP 
                                           "&#38;#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 
                                             "*&lt;*" 
                                         ) 
                                         (wcmatch 
                                             TMP 
                                             "*&gt;*" 
                                         ) 
                                     ) 
                                     (setq 
                                         TMP 
                                            (STR-TH 
                                                TMP 
                                                '(("&lt;" 
                                                   "&#38;lt;" 
                                                  ) 
                                                  ("&gt;" 
                                                   "&#38;gt;" 
                                                  ) 
                                                 ) 
                                            ) 
                                     ) 
                                 ) 
                                 ;;附加上格式信息 
                                 (setq TMP 
                                          (strcat 
                                              "&lt;FONT face="Fixedsys" COLOR="" 
                                              (nth 
                                                  2 
                                                  LSP2HTM-COL 
                                              ) 
                                              ""&gt;" 
                                              TMP 
                                              "&lt;/FONT&gt;" 
                                          ) 
                                 ) 
                                 (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 
                                             "*&lt;*" 
                                         ) 
                                         (wcmatch 
                                             TMP 
                                             "*&gt;*" 
                                         ) 
                                     ) 
                                     (setq 
                                         TMP 
                                            (STR-TH 
                                                TMP 
                                                '(("&#38;" 
                                                   "&#38;amp;" 
                                                  ) 
                                                  ("&lt;" 
                                                   "&#38;lt;" 
                                                  ) 
                                                  ("&gt;" 
                                                   "&#38;gt;" 
                                                  ) 
                                                 ) 
                                            ) 
                                     ) 
                                 ) 
                                 (setq TMP 
                                          (strcat 
                                              "&lt;FONT size=2 face="Fixedsys" COLOR=" 
                                              (nth 4 LSP2HTM-COL) 
                                              "&gt;&lt;SPAN STYLE="BACKGROUND-COLOR: " 
                                              (nth 3 LSP2HTM-COL) 
                                              ""&gt;" 
                                              TMP 
                                              "&lt;/SPAN&gt;&lt;/FONT&gt;" 
                                          ) 
                                 ) 
                                 (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 "&lt;/PRE&gt;&lt;/BODY&gt;&lt;/HTML&gt;") 
            (princ TMP F2) 
            ;;★五、关闭文件 
            (close F2) 
            (close F1) 
            ;;★六、使用打开htm文档 
            (princ "\r&gt;&gt;&gt;成功操作完成!!") 
            (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 '() 
                  I  1 
            ) 
            (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 '() 
                          N  0 
                    ) 
                    ;;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 "&lt;HTML&gt;" '(("&lt;" "&amp;lt;") ("&gt;" "&amp;gt;")))                
                        返  回："&amp;lt;HTML&amp;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

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

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

用在博客什么的上面不错

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 发布
[B]能否进行批量转换 [/B]

简单修改即可实现批量转换。
 
方法是：将转换部分定义为函数，文件名称以参数的方式传入。

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

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

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

相关帖子