请问DCL与lsp合并该怎么做

皇上快溜

就是想把DCL文件里面的代码复制粘贴到lsp里面，让两者合二为一，成为一个含DCL的lsp文件

皇上快溜

这有一个据说可以将dc代码转为lsp格式的程序，，，，，几经摸索仍不得要领

;;;=================================================================*
;;;                                                                 *
;;;功能：将dcl文件转换为一个lisp函数。                              *
;;;      函数的功能是，生成临时dcl，返回临时文件的路径全名。        *
;;;      摆脱dcl文件位置的束缚。                                    *
;;;                                                                 *
;;;=================================================================*
;;;测试
(defun c:tt () (c:dcl2lsp))
;;;=================================================================*
(defun c:dcl2lsp (/ filename_dcl lst_str filename_lsp f str)
  (and
    ;; 1、选择原始dcl文件
    (setq filename_dcl
           (getfiled "选择dcl文件"
                     ""
                     "dcl"
                     4
           )
    )
    ;; 2、生成lisp源码
    (setq lst_str (zl-dcl->lsp filename_dcl))
    ;; 3、输出lsp文件
    (setq filename_lsp (strcat filename_dcl ".lsp"))
    (setq f (open filename_lsp "w"))
    (foreach str lst_str (princ "\n" f) (princ str f))
    (not(close f))
    ;; 4、用记事本显示，lsp文件内容
    (startapp "notepad" filename_lsp)
  )
  (princ)
)
;;;=================================================================*
;;;      通用函数                                                   *
;;;功能：
;;;参数：filename_dcl  -----原始dcl文件名。                         *
;;;返回：字符串表。内容组合为lsp函数定义。                          *
(defun zl-dcl->lsp (filename_dcl / f lst_str0 lst_str1 lst_str2)

  ;; 1、读取dcl文件内容
  (if (setq f (open filename_dcl "r"))
    (progn
      (setq lst_str1 '())
      (while (setq str (read-line F))
        (setq str      (vl-prin1-to-string str)
              lst_str1 (cons str lst_str1)
        )
      )
      (setq lst_str1 (reverse lst_str1))
      (close f)
    )
  )
  ;; 2、定义前缀
  (setq        lst_str0
          (list
            ";;;=================================================================*"
            (strcat ";;;生成日期：" (rtos (getvar "cdate") 2 6))
            ";;;本文件由程序自动生成。                                           *"
            ";;;程序生成完成后需将主代码“*.lsp”文件中的语句中的     *"
            ";;; (load_dialog 双引号*.Dcl双引号)改为(load_dialog (make-dcl)) 方可用            *"
            ";;;修改后的代码可编辑到主LISP程序后方运行                                                                 *"
            ";;;=================================================================*"
            ";;;为能让多个有本程序生成的DCL.lsp可以同时使用，生成程序后应将对话框名 (make-dcl)改名   *"
            ";;;供需修改两处地方，一处为加载的地方(load_dialog (？？？-make-dcl)) ，另一处为       *"
            ";;;对话框主程序名(defun ？？？-make-dcl    ，一定要一致                      *"
            ";;;示例：(make-dcl)                                                 *"
            "(defun make-dcl  (/ lst_str str file f)"
            "\t\t(setq lst_str '("
          )
  )
  ;; 3、定义后缀
  (setq        lst_str2
         '("                    )"
           "    )"
           "    (setq file (vl-filename-mktemp \"DclTemp.dcl\"))"
           "    (setq f (open file \"w\"))"
           "    (foreach str lst_str"
           "        (princ \"\\n\" f)"
           "        (princ str f)"
           "    )"
           "    (close f)"
           "    ;;返回"
           "    file"
           ")"
           ";;;=================================================================*"
           "(princ)"
          )
  )
  ;; 4、返回
  (append lst_str0 lst_str1 lst_str2)
)

tangjunasd58

是的这个可以生成为LSP的

皇上快溜

tangjunasd58 发表于 2016-6-19 19:29
是的这个可以生成为LSP的

你好，帮我看看这个怎么编辑好吗


;;;=================================================================*
;;;生成日期：20160619.221814
;;;本文件由程序自动生成。                                           *
;;;程序生成完成后需将主代码“*.lsp”文件中的语句中的     *
;;; (load_dialog 双引号*.Dcl双引号)改为(load_dialog (make-dcl)) 方可用            *
;;;修改后的代码可编辑到主LISP程序后方运行                                                                 *
;;;=================================================================*
;;;为能让多个有本程序生成的DCL.lsp可以同时使用，生成程序后应将对话框名 (make-dcl)改名   *
;;;供需修改两处地方，一处为加载的地方(load_dialog (？？？-make-dcl)) ，另一处为       *
;;;对话框主程序名(defun ？？？-make-dcl    ，一定要一致                      *
;;;示例：(make-dcl)                                                 *
(defun make-dcl  (/ lst_str str file f)
                (setq lst_str '(
"punch:dialog{"
"        label=\"**金丰冲床规格表**\";"
"        spacer;"
" :boxed_row{"
"  :column{"
"    label=\"机台规格\";"
"    :text{label=\"OCP-25;\";}"
"    :text{label=\"OCP-35;\";}"
"    :text{label=\"OCP-45;\";}"
"    :text{label=\"OCP-60;\";}"
"    :text{label=\" G1 - 80;\";} "
"    :text{label=\" G1- 110;\";}"
"    :text{label=\" G1- 160;\";}"
"    :text{label=\" G2- 160;\";}"
"    :text{label=\" G1- 200;\";}"
"    :text{label=\" G2- 200;\";}  "
"    :text{label=\" G2- 250;\";} "
"    :text{label=\"油压机-100;\";}"
"    :text{label=\"OCP -260;\";}}"
"  :column {"
"    label=\"闭 模 高 度\";"
"    :text{label=\"150~200;\";}  "
"    :text{label=\"470~550;\";}"
"    :text{label=\"180~240;\";}"
"    :text{label=\"225~300;\";}  "
"    :text{label=\"250~320;\";}"
"    :text{label=\"290~340;\";}"
"    :text{label=\"380~440;\";}"
"    :text{label=\"350~450;\";}"
"    :text{label=\"370~440;\";}"
"    :text{label=\"390~500;\";}"
"    :text{label=\"430~550;\";}"
"    :text{label=\"550~900;\";}  "
"    :text{label=\"380~500;\";}}"
"  :column {"
"    label=\"连续模下模高度\";"
"    :text{label=\"**********\";}"
"    :text{label=\"140~200;\";}   "
"    :text{label=\"140~200;\";}"
"    :text{label=\"**********\";} "
"    :text{label=\"140~200;\";}"
"    :text{label=\"200~290;\";} "
"    :text{label=\"200~290;\";}"
"    :text{label=\"200~290;\";}   "
"    :text{label=\"200~290;\";}"
"    :text{label=\"200~290;\";} "
"    :text{label=\"200~290;\";}"
"    :text{label=\"200~290;\";}  "
"    :text{label=\"200~290;\";}}"
"    }"
"    ok_only;"
"       }"
                    )









(defun c:press ()
  (if (= outline nil)
    (load "outline")
  )
  (setq        nn 3
        long 0
  )
  (while (>= nn 2)
    (setq dcl-id (load_dialog "press"))
    (if        (null (new_dialog "press" dcl-id))
      (exit)
    )
    (setq thick (atof (get_tile "thick")))
    (if        long
      (set_tile "L" (rtos long 2 2))
    )
    (if        (setq thick (Xrecord-out "press"))
      (progn
        (set_tile "thick" thick)
        (setq thick (atof thick))
      )
    )
    (if        (>= thick 3)
      (set_tile "KX" "0.2")
    )
    (action_tile
      "ls"
      "(Xrecord-in(get_tile \"thick\")\"press\")(done_dialog 4)"
    )
    (action_tile "accept" "(press-ok)")
    (setq nn (start_dialog))
    (unload_dialog dcl-id)
    (if        (= nn 4)
      (press-select)
    )
  )
  (princ)
)
(defun press-select ()
  (princ "\n请选择料带上的冲裁轮廓.")
  (setq        ss   (ssget '((-4 . "<or")
                      (0 . "line")
                      (0 . "circle")
                      (0 . "arc")
                      (0 . "lwpolyline")
                      (-4 . "or>")
                     )
             )
        long 0
        j    -1
  )
  (if ss
    (progn
      (repeat (sslength ss)
        (setq en (entget (setq sa (ssname ss (setq j (+ j 1))))))
        (if (= (setq en-name (cdr (assoc 0 en))) "LWPOLYLINE")
          (progn
            (command "area" "o" sa)
            (setq long1 (getvar "PERIMETER"))
          )
          (if (= en-name "LINE")
            (progn
              (command "pedit" sa "y" "j" sa "" "")
              (command "area" "o" (entlast))
              (setq long1 (getvar "PERIMETER"))
            )
            (progn
              (command "list" sa "")
              (setq r1 (cdr (assoc 40 en)))
              (setq long1 (* pi (* 2 r1)))
            )
          )
        )
        (setq long (+ long long1))
      )
    )
    (setq long 0)
  )
)
(defun press-ok        ()
  (setq L (atof (get_tile "L")))
  (setq A (atof (get_tile "A")))
  (setq K (atof (get_tile "K")))
  (setq thick (atof (get_tile "thick")))
  (setq p0 (/ (* thick L A) 1000))
  (setq px (* p0 (atof (get_tile "KX"))))
  (set_tile "P0" (rtos p0 2 2))
  (set_tile "PX" (rtos pX 2 2))
  (set_tile "PU" (rtos (+ (* K p0) px) 2 2))
  (Xrecord-in (rtos thick 2 2) "press")
)

皇上快溜

;;;=================================================================*
;;;生成日期：20160619.221814
;;;本文件由程序自动生成。                                           *
;;;程序生成完成后需将主代码“*.lsp”文件中的语句中的     *
;;; (load_dialog 双引号*.Dcl双引号)改为(load_dialog (make-dcl)) 方可用            *
;;;修改后的代码可编辑到主LISP程序后方运行                                                                 *
;;;=================================================================*
;;;为能让多个有本程序生成的DCL.lsp可以同时使用，生成程序后应将对话框名 (make-dcl)改名   *
;;;供需修改两处地方，一处为加载的地方(load_dialog (？？？-make-dcl)) ，另一处为       *
;;;对话框主程序名(defun ？？？-make-dcl    ，一定要一致                      *
;;;示例：(make-dcl)                                                 *
(defun make-dcl  (/ lst_str str file f)
                (setq lst_str '(
"punch:dialog{"
"        label=\"**金丰冲床规格表**\";"
"        spacer;"
" :boxed_row{"
"  :column{"
"    label=\"机台规格\";"
"    :text{label=\"OCP-25;\";}"
"    :text{label=\"OCP-35;\";}"
"    :text{label=\"OCP-45;\";}"
"    :text{label=\"OCP-60;\";}"
"    :text{label=\" G1 - 80;\";} "
"    :text{label=\" G1- 110;\";}"
"    :text{label=\" G1- 160;\";}"
"    :text{label=\" G2- 160;\";}"
"    :text{label=\" G1- 200;\";}"
"    :text{label=\" G2- 200;\";}  "
"    :text{label=\" G2- 250;\";} "
"    :text{label=\"油压机-100;\";}"
"    :text{label=\"OCP -260;\";}}"
"  :column {"
"    label=\"闭 模 高 度\";"
"    :text{label=\"150~200;\";}  "
"    :text{label=\"470~550;\";}"
"    :text{label=\"180~240;\";}"
"    :text{label=\"225~300;\";}  "
"    :text{label=\"250~320;\";}"
"    :text{label=\"290~340;\";}"
"    :text{label=\"380~440;\";}"
"    :text{label=\"350~450;\";}"
"    :text{label=\"370~440;\";}"
"    :text{label=\"390~500;\";}"
"    :text{label=\"430~550;\";}"
"    :text{label=\"550~900;\";}  "
"    :text{label=\"380~500;\";}}"
"  :column {"
"    label=\"连续模下模高度\";"
"    :text{label=\"**********\";}"
"    :text{label=\"140~200;\";}   "
"    :text{label=\"140~200;\";}"
"    :text{label=\"**********\";} "
"    :text{label=\"140~200;\";}"
"    :text{label=\"200~290;\";} "
"    :text{label=\"200~290;\";}"
"    :text{label=\"200~290;\";}   "
"    :text{label=\"200~290;\";}"
"    :text{label=\"200~290;\";} "
"    :text{label=\"200~290;\";}"
"    :text{label=\"200~290;\";}  "
"    :text{label=\"200~290;\";}}"
"    }"
"    ok_only;"
"       }"
                    )
    )
    (setq file (vl-filename-mktemp "DclTemp.dcl"))
    (setq f (open file "w"))
    (foreach str lst_str
        (princ "\n" f)
        (princ str f)
    )
    (close f)
    ;;返回
    file
)
;;;=================================================================*
(princ)

皇上快溜

(defun c:press ()
  (if (= outline nil)
    (load "outline")
  )
  (setq        nn 3
        long 0
  )
  (while (>= nn 2)
    (setq dcl-id (load_dialog "press"))
    (if        (null (new_dialog "press" dcl-id))
      (exit)
    )
    (setq thick (atof (get_tile "thick")))
    (if        long
      (set_tile "L" (rtos long 2 2))
    )
    (if        (setq thick (Xrecord-out "press"))
      (progn
        (set_tile "thick" thick)
        (setq thick (atof thick))
      )
    )
    (if        (>= thick 3)
      (set_tile "KX" "0.2")
    )
    (action_tile
      "ls"
      "(Xrecord-in(get_tile \"thick\")\"press\")(done_dialog 4)"
    )
    (action_tile "accept" "(press-ok)")
    (setq nn (start_dialog))
    (unload_dialog dcl-id)
    (if        (= nn 4)
      (press-select)
    )
  )
  (princ)
)
(defun press-select ()
  (princ "\n请选择料带上的冲裁轮廓.")
  (setq        ss   (ssget '((-4 . "<or")
                      (0 . "line")
                      (0 . "circle")
                      (0 . "arc")
                      (0 . "lwpolyline")
                      (-4 . "or>")
                     )
             )
        long 0
        j    -1
  )
  (if ss
    (progn
      (repeat (sslength ss)
        (setq en (entget (setq sa (ssname ss (setq j (+ j 1))))))
        (if (= (setq en-name (cdr (assoc 0 en))) "LWPOLYLINE")
          (progn
            (command "area" "o" sa)
            (setq long1 (getvar "PERIMETER"))
          )
          (if (= en-name "LINE")
            (progn
              (command "pedit" sa "y" "j" sa "" "")
              (command "area" "o" (entlast))
              (setq long1 (getvar "PERIMETER"))
            )
            (progn
              (command "list" sa "")
              (setq r1 (cdr (assoc 40 en)))
              (setq long1 (* pi (* 2 r1)))
            )
          )
        )
        (setq long (+ long long1))
      )
    )
    (setq long 0)
  )
)
(defun press-ok        ()
  (setq L (atof (get_tile "L")))
  (setq A (atof (get_tile "A")))
  (setq K (atof (get_tile "K")))
  (setq thick (atof (get_tile "thick")))
  (setq p0 (/ (* thick L A) 1000))
  (setq px (* p0 (atof (get_tile "KX"))))
  (set_tile "P0" (rtos p0 2 2))
  (set_tile "PX" (rtos pX 2 2))
  (set_tile "PU" (rtos (+ (* K p0) px) 2 2))
  (Xrecord-in (rtos thick 2 2) "press")
)

皇上快溜

tangjunasd58 发表于 2016-6-19 19:29
是的这个可以生成为LSP的

你好，帮我看看楼上两个怎么合并好吗

皇上快溜

操作失误，事后才发现发了重复内容，抱歉，，给管理员添乱了

zj20190405

皇上快溜 发表于 2016-6-19 17:19
这有一个据说可以将dc代码转为lsp格式的程序，，，，，几经摸索仍不得要领

;;;======================== ...

老哥，效果不错，但是能不能直接获取dcl文件的名称，然后转出来的lsp文件的load_dialog直接引用获取的dcl文件名，那样的话就不用再修改load_dialog名称了