一键合并DCL和LSP文件

baitang36

一键合并DCL和LSP文件（已改进，可以支持lsp文件中带注释）

;;先单独写dcl和lsp，调试好后一键合并。
;; by baitang36   (QQ 5520971)    2022-06-06
;;部分代码参考 lee50310  DCL2LSP  在此表示感谢！
;;
;;命令: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

669423907

非常感谢楼主分享好码

cchessbd

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

baitang36 发表于 2022-11-11 08:35
已按你的要求改进，请试用。
感谢。

经过本人日以继夜对源码的研读，终于搞明白了怎么去除生成的临时文件。上传到帖子吧。。。调试基本成功。
但怎么调用生成的dcl临时文件函数还没有搞明白。因为dcl文件载入刚好是一个变量。每个dcl文件都不一样。。。
如果生成临时文件不为函数，假如多次载入合并后的lsp，则会生成多个临时dcl文件。用函数就没有这个问题，用的时候再生成。
现在只能手动去查找改lsp了。。。



抱歉，脑子不行，调试不过，暂时搁置了。。。把这个半成品发上来，盛老师有时间能帮完善一下就更好。

guosheyang

感谢大佬共享代码！

liunian0524

感谢大佬分享代码。原lsp文件注释需要全部删除，否则合并会出错

baitang36

liunian0524 发表于 2022-6-6 17:08
感谢大佬分享代码。原lsp文件注释需要全部删除，否则合并会出错

原因是read-line把回车换行符给丢了。已改进，不用read-line，可以支持注释了。

baitang36

669423907 发表于 2022-6-6 18:57
非常感谢楼主分享好码

已改进，再试试？

whophy

试了下 很不错！  可以合并，也很方便，一键生成。

huxu823

感谢分享。测试很好用！！！！

纵横八方

这个好！这个好

liunian0524

baitang36 发表于 2022-6-6 19:53
原因是read-line把回车换行符给丢了。已改进，不用read-line，可以支持注释了。

好用，谢谢