LISP生成HTML

Lisphk · 发表于 2017-5-18 19:33:29

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

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

×

;|;=====================================================================
功能：将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
""
)
)
(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
""
)
)
(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
""
)
)
(princ tmp f2)
)
)
)
;;字符串
((= stri "\"")
(setq tmp "\"")
;;将模式设置为字符串
(setq 当前模式 1)
)
;;实数
((= (type (read stri)) 'REAL)
(setq
tmp
(strcat
"<FONT face=\"Fixedsys\" COLOR=\""
(nth 5
lsp2htm-col
)
"\">"
stri
""
)
)
(princ tmp f2)
)
;;整数
((= (type (read stri)) 'INT)
(setq
tmp
(strcat
"<FONT face=\"Fixedsys\" COLOR=\""
(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
"&"
(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
""
)
)
(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
""
)
)
(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文件 
按照语法着色，以便于在网页上发布。 
日期； 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 
                     "
                     (nth 0 
                          lsp2htm-col 
                     ) 
                     "\">" 
                     stri 
                     "" 
                   ) 
                ) 
                (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 
                     "
                     (nth 1 
                          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) 
                       ) 
                    ) 
                    (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 
                         "&" 
                         (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 
                          "
                          (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 
                   ) 
                 ) 
                 (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>>>成功操作完成!!\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)

原地踏步 · 发表于 2017-6-22 17:12:24

(defun c:t2 ()
(setq *mSpace* (vla-get-modelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
ent (car (entsel))
obj1 (vlax-ename->vla-object ent)
hatObj (vla-AddHatch *mSpace* 0 "_USER" :vlax-true)
oLoop (vlax-make-safearray vlax-vbObject '(0 . 0))
)
(vlax-safearray-put-element oLoop 0 obj1)
(vla-AppendOuterLoop hatObj oLoop)
(vla-put-PatternSpace hatObj 800)
(vla-put-HatchStyle hatObj acHatchStyleNormal)
(vla-Evaluate hatObj)
)

运行tt ==> ---; 错误: 输入中的点位置不正确

sicky111 · 发表于 2017-6-23 01:12:38

谢谢分享。

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

[每日一码] LISP生成HTML

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