DCL2LSP和LSP2DCL（源码）
本帖最后由 qcw911 于 2012-3-8 10:22 编辑大家早上好
给大家推荐两个关于DCL的源码
不像某些人发一些垃圾帖子
(defun c:dcl2lsp ( / fname1 fn1 fname2 fn2 k fn1l fn2l )
(setq fname1 (getfiled "Select DCL file" "" "dcl" 16))
(setq fn1 (open fname1 "r"))
(setq fname2 (getfiled "File to save" "" "lsp" 1))
(setq fn2 (open fname2 "w"))
(while (setq fn1l (read-line fn1))
(setq fn2l fn1l)
(setq k 0)
(while (setq k (vl-string-search "\"" fn2l k))
(setq fn2l (vl-string-subst "\\\"" "\"" fn2l k))
(setq k (+ k 2))
)
(setq fn2l (strcat "(write-line \"" fn2l "\" fn)"))
(write-line fn2l fn2)
)
(close fn1)
(close fn2)
(princ)
)
(defun c:lsp2dcl ( / fname1 fn1 fname2 fn2 k fn1l fn2l )
(setq fname1 (getfiled "Select LSP file" "" "lsp" 16))
(setq fn1 (open fname1 "r"))
(setq fname2 (getfiled "File to save" "" "dcl" 1))
(setq fn2 (open fname2 "w"))
(while (setq fn1l (read-line fn1))
(setq fn2l fn1l)
(setq fn2l (substr fn2l (+ (vl-string-search "\"" fn2l) 2) (- (vl-string-position (ascii "\"") fn2l nil T) (+ (vl-string-search "\"" fn2l) 1))))
(setq k 0)
(while (setq k (vl-string-search "\\\"" fn2l k))
(setq fn2l (vl-string-subst "\"" "\\\"" fn2l k))
(setq k (+ k 1))
)
(write-line fn2l fn2)
)
(close fn1)
(close fn2)
(princ)
)
;实例
(defun c:TestDialog ( / fname fn dclid lin return# )
(setq fname (vl-filename-mktemp nil nil ".dcl"))
(setq fn (open fname "w"))
(write-line "TestDialog : dialog {" fn)
(write-line "label = \"Testing \\\\ DCL2LSP\";" fn)
(write-line ": edit_box {" fn)
(write-line " key = \"ser\";" fn)
(write-line " label = \"Edit box\";" fn)
(write-line " width = 50;" fn)
(write-line "}" fn)
(write-line ": list_box {" fn)
(write-line " key = \"key\";" fn)
(write-line " label = \"List Box\";" fn)
(write-line " tabs = \"20 35\";" fn)
(write-line " multiple_select = true;" fn)
(write-line " list = \"One\\t1\\nTwo\\t2\\nThree\\t3\";" fn)
(write-line " value = \"1 2\";" fn)
(write-line "}" fn)
(write-line ": text {" fn)
(write-line " key = \"txt\";" fn)
(write-line " height = 3;" fn)
(write-line " value = \"My long line of text\\nhas a second line\";" fn)
(write-line "}" fn)
(write-line "ok_cancel;" fn)
(write-line "}" fn)
(close fn)
(setq fn (open fname "r"))
(setq dclid (load_dialog fname))
(while (or (eq (substr (setq lin (vl-string-right-trim "\" fn)" (vl-string-left-trim "(write-line \"" (read-line fn)))) 1 2) "//") (eq (substr lin 1 (vl-string-search " " lin)) "") (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) " : dialog"))))
(new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq return# (start_dialog))
(princ return#)
(unload_dialog dclid)
(close fn)
(vl-file-delete fname)
(princ)
)
(defun c:viewdcl ( / dclid return# filen fn lin )
(setq dclid (load_dialog (setq filen (getfiled "" "" "dcl" 16))))
(setq fn (open filen "r"))
(while (or (eq (substr (setq lin (read-line fn)) 1 2) "//") (eq (substr lin 1 (vl-string-search " " lin)) "") (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) " : dialog"))))
(new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq return# (start_dialog))
(princ return#)
(unload_dialog dclid)
(princ)
)
收藏了，好好研究研究。谢谢！ back 发表于 2020-5-16 23:18
樓主，請問一下，你的源碼似乎不行執行，您要不要說一下呢
如果你是写程序员
在VLIDE写代码时其实可以改换DCL环境，直接将DCL写入LISP（以同样建立DCL文件
write-line字串表方式）
为何要麻烦写好DCL文件再用dcl2lsp转为LISP不是多此一举吗？ lisperado 发表于 2020-5-17 11:36
如果你是写程序员
在VLIDE写代码时其实可以改换DCL环境，直接将DCL写入LISP（以同样建立DCL文件
write- ...
了解，謝謝你
我再試試看 先下载，收藏，有时间慢慢消化 先下载 做什么用的呢 收藏了，谢谢楼主分享 谢谢楼主，先下了学习下
下了，谢谢分享！！ 请问楼主这个是做什么用的，能不能讲细点，谢谢 支持下， 我是菜鸟,能给做个说明好吗