明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 30698|回复: 113

DCL2LSP和LSP2DCL(源码)

    [复制链接]
发表于 2012-3-8 08:56 | 显示全部楼层 |阅读模式
本帖最后由 qcw911 于 2012-3-8 10:22 编辑

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

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

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


  1. ;实例

  2. (defun c:TestDialog ( / fname fn dclid lin return# )
  3.   (setq fname (vl-filename-mktemp nil nil ".dcl"))
  4.   (setq fn (open fname "w"))

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

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





评分

参与人数 10明经币 +11 收起 理由
品茗新秀 + 1 很给力!
zctao1966 + 1 很给力!
ucuc2003 + 1 需要急用!!感谢
xgr + 1 正好需要
自贡黄明儒 + 1 赞一个!
china小球 + 1 很给力!
yjr111 + 1 神马都是浮云!
xiaxiang + 1 不错!
langjs + 2 很给力!
mccad + 1 赞一个!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下

本帖被以下淘专辑推荐:

发表于 2012-4-6 18:07 | 显示全部楼层
收藏了,好好研究研究。谢谢!
回复 支持 0 反对 1

使用道具 举报

发表于 2020-5-17 11:36 | 显示全部楼层
back 发表于 2020-5-16 23:18
樓主,請問一下,你的源碼似乎不行執行,您要不要說一下呢

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

为何要麻烦写好DCL文件再用dcl2lsp转为LISP不是多此一举吗?
发表于 2020-5-23 11:02 | 显示全部楼层
lisperado 发表于 2020-5-17 11:36
如果你是写程序员
在VLIDE写代码时其实可以改换DCL环境,直接将DCL写入LISP(以同样建立DCL文件
write- ...

了解,謝謝你
我再試試看
发表于 2012-3-8 09:11 | 显示全部楼层
先下载,收藏,有时间慢慢消化
发表于 2012-3-8 09:25 | 显示全部楼层
先下载
发表于 2012-3-8 09:39 | 显示全部楼层
做什么用的呢
发表于 2012-3-8 10:05 | 显示全部楼层
收藏了,谢谢楼主分享
发表于 2012-3-8 10:34 | 显示全部楼层
谢谢楼主,先下了学习下
发表于 2012-3-8 10:35 | 显示全部楼层
下了,谢谢分享!!
发表于 2012-3-8 11:16 | 显示全部楼层
请问楼主这个是做什么用的,能不能讲细点,谢谢
发表于 2012-3-8 12:58 | 显示全部楼层
支持下,
发表于 2012-3-8 14:24 | 显示全部楼层
我是菜鸟,能给做个说明好吗
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-5-13 08:45 , Processed in 0.189715 second(s), 38 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表