一键合并DCL和LSP文件
本帖最后由 baitang36 于 2022-11-11 08:33 编辑一键合并DCL和LSP文件（已改进，可以支持lsp文件中带注释）
;;先单独写dcl和lsp，调试好后一键合并。
;; by baitang36 (QQ 5520971) 2022-06-06
;;部分代码参考 lee50310DCL2LSP在此表示感谢！
;;
;;命令:BDL
;;要求：只能有一个dcl文件，并且主文件名和lsp文件名相同。例如：只能把abcd.dcl与abcd.lsp合并
(defun C:BDL (/ dclFName dcl lspFName lsp str n j k m str1 str2 str5 start1 lstr1 yh)
;; 获取 DCL 文件的名称
(setq dclFName (findfile (getfiled "选择 DCL与LSP合并" "" "dcl"16)))
(setq lspFName
(strcat (substr dclFName 1 (- (strlen dclFName) 4)) ".lsp")
)
(setq newFName (strcat (substr dclFName 1 (- (strlen dclFName) 4))
"_new.lsp"
)
)
(setq dcl (open dclFName "r") ;打开 DCL 进行读取
lsp (open newFName "w") ;打开 LSP 进行写入
)
(setq f0 (open lspFName "r"))
(setq str1 "")
(while (setq nstr5 (read-char f0))
(setq str5 (chr nstr5))
(setq str1 (strcat str1 str5))
)
(close f0)
(setq lstr1 (strlen str1))
(setq start1 1)
(setq j 1
k 0
m 0
n 0
) ;_ setq
(setq str2 "")
(while (< j lstr1)
(if
(OR
(eq (substr str1 j 13) "(load_dialog ")
(eq (substr str1 j 13) "(LOAD_DIALOG ")
) ;_ OR
(progn
(setq m j)
(setq str2 (strcat str2 (substr str1 start1 (- m start1))))
(setq j (+ j 1))
(setq k 1)
(setq yh 0)
(while (/= 0 k)
(if (eq "\"" (substr str1 j 1))
(setq yh (boole 6 yh 1))
)
(if (eq "(" (substr str1 j 1))
(if (= yh 0)
(setq k (1+ k))
)
) ;_ if
(if (eq ")" (substr str1 j 1))
(if (= yh 0)
(setq k (- k 1))
)
) ;_ if
(setq j (+ j 1))
) ;_ while
(setq n j)
(setq str3 (substr str1 m (- n m))) ;IF
(setq str4 "(load_dialog tmp-dcl-file-name)")
(setq str2 (strcat str2 str4))
(setq start1 n)
)
)
(setq j (+ j 1))
)
(setq str2 (strcat str2 (substr str1 start1 (+ (- lstr1 start1) 1))))
;; Start LSP
(setq str
(strcat
";<<<<<<合并DCL和lsp文件baitang36 20220606 >>>>>> \n\n"
" (setq dcl_file (open (setq tmp-dcl-file-name (vl-filename-mktemp nil nil\".DCL\")) \"w\"))\n"
" (progn\n" " (foreach x \n"
" '(\n") ;_ end of strcat
) ;_ end of setq
(write-line str lsp)
;;读取 DCL 中的每一行并写入 LSP
(while (setq str (read-line dcl))
;; 用反斜杠作为所有反斜杠的前缀
(setq n 1)
(while (<= n (strlen str))
(if (= (substr str n 1) "\\")
(progn
(if (= n 1)
(setq str (strcat "\\" str))
(setq
str (strcat (substr str 1 (- n 1)) "\\" (substr str n))
)
) ;_ end of if
(setq n (+ n 2))
) ;_ end of progn
(setq n (1+ n))
) ;_ end of if
) ;_ end of while
;;在所有双引号前加上反斜杠
(setq n 1)
(while (<= n (strlen str))
(if (= (substr str n 1) "\"")
(progn
(if (= n 1)
(setq str (strcat "\\" str))
(setq
str (strcat (substr str 1 (- n 1)) "\\" (substr str n))
)
) ;_ end of if
(setq n (+ n 2))
) ;_ end of progn
(setq n (1+ n))
) ;_ end of if
) ;_ end of while
;; 写入文件
(write-line
(strcat " \"" str "\"")
lsp
)
) ;_ end of while
(setq str (strcat " ) (write-line x dcl_file) )\n"
" (setq dcl_file (close dcl_file)))\n"
)
)
(write-line str lsp)
(write-line str2 lsp)
(close lsp)
(close dcl)
(princ "\n")
(prompt (strcat " << *** DCL和LSP文件合并完成 *** >> 文件名"
newFName
)
)
(prin1)
) ;_ end of defun
非常感谢楼主分享好码 baitang36 发表于 2022-11-11 08:35
已按你的要求改进，请试用。
感谢。
这个位置不对，和我之前的改动一样。出不来菜单。一共有三个位置要改。图中2个红色箭头部分。
还有起始位置一个定义一个函数名，此函数名最好能采用数字+随机变量的形式。以免多个lsp合并出问题。
至于为什么要把初始化定义为函数，肯定是有原因的。论坛里面好多lsp都有“嵌套命令不能超过4层的”提示，导致CAD出错，而非正常终止的问题。
定义为函数在dcl_bhatch这里调用，就能避免这类问题。当然，dcl_bhatch 估计也得改成随机的函数名了。
如果要完美的话，就是 (dcl_bhatch) (dcl_file_New)均为该次合并时的随机名称，(dcl_file_New)即为dcl初始化参数用。
照图片位置加载、删除就没有多个临时垃圾文件的问题。(dcl_bhatch)随机则可以避免多个合并了dcl的lsp再次合并编译函数重名的问题。
本帖最后由 cchessbd 于 2022-11-14 12:24 编辑
baitang36 发表于 2022-11-11 08:35
已按你的要求改进，请试用。
感谢。
经过本人日以继夜对源码的研读，终于搞明白了怎么去除生成的临时文件。上传到帖子吧。。。调试基本成功。
但怎么调用生成的dcl临时文件函数还没有搞明白。因为dcl文件载入刚好是一个变量。每个dcl文件都不一样。。。
如果生成临时文件不为函数，假如多次载入合并后的lsp，则会生成多个临时dcl文件。用函数就没有这个问题，用的时候再生成。
现在只能手动去查找改lsp了。。。
抱歉，脑子不行，调试不过，暂时搁置了。。。把这个半成品发上来，盛老师有时间能帮完善一下就更好。
感谢大佬共享代码！ 感谢大佬分享代码。原lsp文件注释需要全部删除，否则合并会出错 本帖最后由 baitang36 于 2022-6-6 20:38 编辑
liunian0524 发表于 2022-6-6 17:08
感谢大佬分享代码。原lsp文件注释需要全部删除，否则合并会出错
原因是read-line把回车换行符给丢了。已改进，不用read-line，可以支持注释了。 669423907 发表于 2022-6-6 18:57
非常感谢楼主分享好码
已改进，再试试？ 试了下 很不错！可以合并，也很方便，一键生成。 感谢分享。测试很好用！！！！ 这个好！这个好 baitang36 发表于 2022-6-6 19:53
原因是read-line把回车换行符给丢了。已改进，不用read-line，可以支持注释了。
好用，谢谢