将lsp文件转换成htm文件 - 精华帖集合
www.dimcax.com
将lsp文件转换成htm文件
,
;|;=====================================================================
功能： 将lsp文件转换成htm文件
按照语法着色，以便于在网页上发布。
日期； zml84 于 2007-05-08
|;
;|;====================================================================
;;全局变量：颜色
0 "#ff0000" 红色 括号
1 "#0000ff" 蓝色 符号
2 "#ff00ff" 粉红 字符串
3 "#cccccc" 灰色 注释背景色
4 "#990099" 黑红色 注释
5 "#009999" 兰色 实数
6 "#009900" 绿色 整数
|;
(setq lsp2htm-col
'("#ff0000" "#0000ff" "#ff00ff" "#cccccc" "#990099" "#009999"
"#009900")
)
;;;=====================================================================
;;全局变量：系统保留字
(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
"<font face=\"fixedsys\" color=\""
(nth 0
lsp2htm-col
)
"\">"
stri
"</font>"
)
)
(princ tmp f2)
)
;;空格、tab
((or (= stri " ")
(= stri "\t")
)
(setq
tmp
stri
)
(princ tmp
f2
)
)
;;lisp系统保留字符
((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
"<font face=\"fixedsys\" color=\""
(nth 1
lsp2htm-col
)
"\">"
stri
"</font>"
)
)
(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)
)
)
(setq tmp
(strcat
"<font face=\"fixedsys\" color="
(nth 4
lsp2htm-col
)
"><span style=\"background-color: "
(nth 3
lsp2htm-col
)
"\">"
tmp
"</span></font>"
)
)
(princ tmp f2)
)
)
)
;;字符串
((= stri "\"")
(setq tmp "\"")
;;将模式设置为字符串
(setq 当前模式 1)
)
;;实数
((= (type (read stri)) 'real)
(setq
tmp
(strcat
"<font face=\"fixedsys\" color=\""
(nth 5
lsp2htm-col
)
"\">"
stri
"</font>"
)
)
(princ tmp f2)
)
;;整数
((= (type (read stri)) 'int)
(setq
tmp
(strcat
"<font face=\"fixedsys\" color=\""
(nth 6
lsp2htm-col
)
"\">"
stri
"</font>"
)
)
(princ tmp f2)
)
;;截断处理
(t
(setq
tmp
(strcat
"<font face=\"fixedsys\">"
stri
"</font>"
)
)
(princ tmp f2)
)
)
) ;_结束 代码模式
;;★3.1字符串模式
((= 当前模式 1)
(cond
;;以 & 开头的htm格式符号
((wcmatch stri "&*")
(setq tmp
(strcat
tmp
"&"
(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
'(("<"
"<"
)
(">"
">"
)
)
)
)
)
;;附加上格式信息
(setq tmp
(strcat
"<font face=\"fixedsys\" color=\""
(nth
2
lsp2htm-col
)
"\">"
tmp
"</font>"
)
)
(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
)
)
(setq tmp
(strcat
"<font size=2 face=\"fixedsys\" color="
(nth 4 lsp2htm-col)
"><span style=\"background-color: "
(nth 3 lsp2htm-col)
"\">"
tmp
"</span></font>"
)
)
(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>>>成功操作完成!!\n")
(zml-speak "成功操作完成，感谢使用!!")
(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>" '(("<" "<") (">" ">")))
返 回："<html>"
日 期：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
;|;=====================================================================
定义函数：语音提示
参数说明：str---要说的话，参数类型：字符串
返回值 ：字符串
示 例：(zml-speak "欢迎您!" 0)
返 回："欢迎您!"
日 期：zml84 于2007-05-10
|;
(defun zml-speak (str)
(vl-load-com)
(if (= (type str) 'str)
(if (setq sapi (vlax-create-object "sapi.spvoice"))
(progn
(vlax-invoke
sapi
"speak"
str
0
)
(vlax-release-object sapi)
str
)
)
)
)
;;;=====================================================================
;;;加载后的提示信息
(princ "\nlsp转换htm 加载完成!!")
(zml-speak "加载完成!!输入命令tt开始运行")
(princ "\n★输入命令tt开始运行\n")
(princ)
复制代码
将lsp文件转换成htm文件——确实是东东呀！对整理自己的代码，大有好处。
哇！寫lisp的境界這麼高！！
good good study day-day up!
good good study day-day up!