DCL2LSP和LSP2DCL（源码）

qcw911

大家早上好
给大家推荐两个关于DCL的源码
不像某些人发一些垃圾帖子

2. (defun c:dcl2lsp ( / fname1 fn1 fname2 fn2 k fn1l fn2l )
   
3.   (setq fname1 (getfiled "Select DCL file" "" "dcl" 16))
   
4.   (setq fn1 (open fname1 "r"))
   
5.   (setq fname2 (getfiled "File to save" "" "lsp" 1))
   
6.   (setq fn2 (open fname2 "w"))
   
7.   (while (setq fn1l (read-line fn1))
   
8.     (setq fn2l fn1l)
   
9.     (setq k 0)
   
10.     (while (setq k (vl-string-search """ fn2l k))
    
11.       (setq fn2l (vl-string-subst "\\"" """ fn2l k))
    
12.       (setq k (+ k 2))
    
13.     )
    
14.     (setq fn2l (strcat "(write-line "" fn2l "" fn)"))
    
15.     (write-line fn2l fn2)
    
16.   )
    
17.   (close fn1)
    
18.   (close fn2)
    
19.   (princ)
    
20. )
    
21. 
    

(defun c:dcl2lsp ( / fname1 fn1 fname2 fn2 k fn1l fn2l )<br />   (setq fname1 (getfiled "Select DCL file" "" "dcl" 16))<br />   (setq fn1 (open fname1 "r"))<br />   (setq fname2 (getfiled "File to save" "" "lsp" 1))<br />   (setq fn2 (open fname2 "w"))<br />   (while (setq fn1l (read-line fn1))<br />     (setq fn2l fn1l)<br />     (setq k 0)<br />     (while (setq k (vl-string-search """ fn2l k))<br />       (setq fn2l (vl-string-subst "\\"" """ fn2l k)) <br />       (setq k (+ k 2))<br />     )<br />     (setq fn2l (strcat "(write-line "" fn2l "" fn)"))<br />     (write-line fn2l fn2)<br />   )<br />   (close fn1)<br />   (close fn2)<br />   (princ)<br /> )<br /> <br />

2. (defun c:lsp2dcl ( / fname1 fn1 fname2 fn2 k fn1l fn2l )
   
3.   (setq fname1 (getfiled "Select LSP file" "" "lsp" 16))
   
4.   (setq fn1 (open fname1 "r"))
   
5.   (setq fname2 (getfiled "File to save" "" "dcl" 1))
   
6.   (setq fn2 (open fname2 "w"))
   
7.   (while (setq fn1l (read-line fn1))
   
8.     (setq fn2l fn1l)
   
9.     (setq fn2l (substr fn2l (+ (vl-string-search """ fn2l) 2) (- (vl-string-position (ascii """) fn2l nil T) (+ (vl-string-search """ fn2l) 1))))
   
10.     (setq k 0)
    
11.     (while (setq k (vl-string-search "\\"" fn2l k))
    
12.       (setq fn2l (vl-string-subst """ "\\"" fn2l k))
    
13.       (setq k (+ k 1))
    
14.     )
    
15.     (write-line fn2l fn2)
    
16.   )
    
17.   (close fn1)
    
18.   (close fn2)
    
19.   (princ)
    
20. )
    
21. 
    

(defun c:lsp2dcl ( / fname1 fn1 fname2 fn2 k fn1l fn2l )<br />   (setq fname1 (getfiled "Select LSP file" "" "lsp" 16))<br />   (setq fn1 (open fname1 "r"))<br />   (setq fname2 (getfiled "File to save" "" "dcl" 1))<br />   (setq fn2 (open fname2 "w"))<br />   (while (setq fn1l (read-line fn1))<br />     (setq fn2l fn1l)<br />     (setq fn2l (substr fn2l (+ (vl-string-search """ fn2l) 2) (- (vl-string-position (ascii """) fn2l nil T) (+ (vl-string-search """ fn2l) 1)))) <br />     (setq k 0)<br />     (while (setq k (vl-string-search "\\"" fn2l k))<br />       (setq fn2l (vl-string-subst """ "\\"" fn2l k)) <br />       (setq k (+ k 1))<br />     )<br />     (write-line fn2l fn2)<br />   )<br />   (close fn1)<br />   (close fn2)<br />   (princ)<br /> )<br /> <br />

2. 
   
3. ;实例
   
4. 
   
5. (defun c:TestDialog ( / fname fn dclid lin return# )
   
6.   (setq fname (vl-filename-mktemp nil nil ".dcl"))
   
7.   (setq fn (open fname "w"))
   
8. 
   
9. (write-line "TestDialog : dialog {" fn)
   
10. (write-line "  label = "Testing \\\\ DCL2LSP";" fn)
    
11. (write-line "  : edit_box {" fn)
    
12. (write-line "    key = "ser";" fn)
    
13. (write-line "    label = "Edit box";" fn)
    
14. (write-line "    width = 50;" fn)
    
15. (write-line "  }" fn)
    
16. (write-line "  : list_box {" fn)
    
17. (write-line "    key = "key";" fn)
    
18. (write-line "    label = "List Box";" fn)
    
19. (write-line "    tabs = "20 35";" fn)
    
20. (write-line "    multiple_select = true;" fn)
    
21. (write-line "    list = "One\\t1\\nTwo\\t2\\nThree\\t3";" fn)
    
22. (write-line "    value = "1 2";" fn)
    
23. (write-line "  }" fn)
    
24. (write-line "  : text {" fn)
    
25. (write-line "    key = "txt";" fn)
    
26. (write-line "    height = 3;" fn)
    
27. (write-line "    value = "My long line of text\\nhas a second line";" fn)
    
28. (write-line "  }" fn)
    
29. (write-line "  ok_cancel;" fn)
    
30. (write-line "}" fn)
    
31.   
    
32.   (close fn)
    
33.   (setq fn (open fname "r"))
    
34.   (setq dclid (load_dialog fname))
    
35.   (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"))))
    
36.   (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
    
37.   (action_tile "accept" "(done_dialog 1)")
    
38.   (action_tile "cancel" "(done_dialog 0)")
    
39.   (setq return# (start_dialog))
    
40.   (princ return#)
    
41.   (unload_dialog dclid)
    
42.   (close fn)
    
43.   (vl-file-delete fname)
    
44.   (princ)
    
45. )
    

<br /> ;实例<br /> <br /> (defun c:TestDialog ( / fname fn dclid lin return# )<br />   (setq fname (vl-filename-mktemp nil nil ".dcl"))<br />   (setq fn (open fname "w"))<br /> <br /> (write-line "TestDialog : dialog {" fn)<br /> (write-line "  label = "Testing \\\\ DCL2LSP";" fn)<br /> (write-line "  : edit_box {" fn)<br /> (write-line "    key = "ser";" fn)<br /> (write-line "    label = "Edit box";" fn)<br /> (write-line "    width = 50;" fn)<br /> (write-line "  }" fn)<br /> (write-line "  : list_box {" fn)<br /> (write-line "    key = "key";" fn)<br /> (write-line "    label = "List Box";" fn)<br /> (write-line "    tabs = "20 35";" fn)<br /> (write-line "    multiple_select = true;" fn)<br /> (write-line "    list = "One\\t1\\nTwo\\t2\\nThree\\t3";" fn)<br /> (write-line "    value = "1 2";" fn)<br /> (write-line "  }" fn)<br /> (write-line "  : text {" fn)<br /> (write-line "    key = "txt";" fn)<br /> (write-line "    height = 3;" fn)<br /> (write-line "    value = "My long line of text\\nhas a second line";" fn)<br /> (write-line "  }" fn)<br /> (write-line "  ok_cancel;" fn)<br /> (write-line "}" fn)<br />   <br />   (close fn)<br />   (setq fn (open fname "r"))<br />   (setq dclid (load_dialog fname))<br />   (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"))))<br />   (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)<br />   (action_tile "accept" "(done_dialog 1)")<br />   (action_tile "cancel" "(done_dialog 0)")<br />   (setq return# (start_dialog))<br />   (princ return#)<br />   (unload_dialog dclid)<br />   (close fn)<br />   (vl-file-delete fname)<br />   (princ)<br /> )<br />

2. (defun c:viewdcl ( / dclid return# filen fn lin )
   
3.   (setq dclid (load_dialog (setq filen (getfiled "" "" "dcl" 16))))
   
4.   (setq fn (open filen "r"))
   
5.   (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"))))
   
6.   (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
   
7.   (action_tile "accept" "(done_dialog 1)")
   
8.   (action_tile "cancel" "(done_dialog 0)")
   
9.   (setq return# (start_dialog))
   
10.   (princ return#)
    
11.   (unload_dialog dclid)
    
12.   (princ)
    
13. )
    

(defun c:viewdcl ( / dclid return# filen fn lin )<br />   (setq dclid (load_dialog (setq filen (getfiled "" "" "dcl" 16))))<br />   (setq fn (open filen "r"))<br />   (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"))))<br />   (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)<br />   (action_tile "accept" "(done_dialog 1)")<br />   (action_tile "cancel" "(done_dialog 0)")<br />   (setq return# (start_dialog))<br />   (princ return#)<br />   (unload_dialog dclid)<br />   (princ)<br /> )<br />

xiaoquansb

收藏了，好好研究研究。谢谢！

lisperado

back 发表于 2020-5-16 23:18
樓主，請問一下，你的源碼似乎不行執行，您要不要說一下呢

如果你是写程序员
在VLIDE写代码时其实可以改换DCL环境，直接将DCL写入LISP（以同样建立DCL文件
write-line字串表方式）

为何要麻烦写好DCL文件再用dcl2lsp转为LISP不是多此一举吗？

back

lisperado 发表于 2020-5-17 11:36
如果你是写程序员
在VLIDE写代码时其实可以改换DCL环境，直接将DCL写入LISP（以同样建立DCL文件
write- ...

了解，謝謝你
我再試試看

puzb2001

先下载，收藏，有时间慢慢消化

longer1000

先下载

dhy

做什么用的呢

革天明

收藏了，谢谢楼主分享

443971181

谢谢楼主，先下了学习下

zyhandw

下了，谢谢分享！！

hhh454

请问楼主这个是做什么用的，能不能讲细点，谢谢

仲文玉

支持下，

先进者

我是菜鸟,能给做个说明好吗