请问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)
) 是的这个可以生成为LSP的 tangjunasd58 发表于 2016-6-19 19:29 static/image/common/back.gif
是的这个可以生成为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 static/image/common/back.gif
是的这个可以生成为LSP的
你好，帮我看看楼上两个怎么合并好吗 操作失误，事后才发现发了重复内容，抱歉，，给管理员添乱了 皇上快溜 发表于 2016-6-19 17:19
这有一个据说可以将dc代码转为lsp格式的程序，，，，，几经摸索仍不得要领
;;;======================== ...
老哥，效果不错，但是能不能直接获取dcl文件的名称，然后转出来的lsp文件的load_dialog直接引用获取的dcl文件名，那样的话就不用再修改load_dialog名称了
页:
[1]