怎么把DCL合并到LISP中

FT272296734 · 发表于 2015-2-3 14:39:16

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;dcl对话框
cmm:dialog {
height = 20 ;
label = "选择物体改变其图层" ;
:list_box {
      fixed_width_font = true ;
      height = 20 ;
      key = "lism" ;
      label = "图层名称选单:" ;
}
ok_cancel;
}

;;;LISP程序

(DEFUN C:test (/ os ce bm ss se la )
(setvar "cmdecho" 0)
(setq ss (ssget))
(if (not (null ss))
  (mpcm)
)
   (princ)
)
;;;;;;
(defun mpcm (/ w lay sslay dcl_id do_what value tbl lism selm
  lenth layer clayer num a b no tem_list cood)
(SETQ W (TBLNEXT "LAYER" T))
(WHILE (/= NIL W)
  (SETQ LAY (CDR (ASSOC 2 W)))
  (if (/= (STRCASE lay) "DEFPOINTS")
  (SETQ SSLAY (append SSLAY (list LAY)))
  )
  (SETQ W (TBLNEXT "LAYER"))
)

   (setq dcl_id (load_dialog "cmm.dcl"))
(setq do_what 3)
(while (> do_what 1)
(if (not (new_dialog "cmm" dcl_id)) (exit))
(mode_tile "lism" 2)
(start_list "lism" 2)
(mapcar 'add_list SSLAY)
(end_list)
(action_tile "selm" "(done_dialog 2)")
(action_tile "lism" "(setq value $value)")
(action_tile "accept" "(setq value (get_tile \"lism\"))(done_dialog 1)")
(setq do_what (start_dialog))
(if (= 2 do_what)
   (setq ss (ssget))
)
)

(unload_dialog dcl_id)
(if (= 1 do_what)
  (progn
(setq lenth (read value)
clayer (nth lenth sslay)
)
(setq tbl (tblsearch "layer" clayer))
(if (not (null tbl))
               (command "_chprop" ss "" "la" clayer "")
)
  )
)
(princ))

炫翔 · 发表于 2015-2-3 16:46:56

论坛有类似例子，不知道放进去啥用，编译成VLX即可

FT272296734 · 发表于 2015-2-3 21:08:00

怎么编译成VLX，能说一下方法吗

sicky111 · 发表于 2015-2-3 23:42:13

要学会搜索。

sicky111 · 发表于 2015-2-3 23:59:27

(defun c:test (/ os ce bm ss se la)
(setvar "cmdecho" 0)
(setq ss (ssget))
(if (not (null ss))
(mpcm)
)
(princ)
)
(defun mpcm (/ w lay sslay dcl_id do_what value
tbl lism selm lenth layer clayer num
a b no tem_list cood
)
(SETQ W (TBLNEXT "LAYER" T))
(WHILE (/= NIL W)
(SETQ LAY (CDR (ASSOC 2 W)))
(if (/= (STRCASE lay) "DEFPOINTS")
(SETQ SSLAY (append SSLAY (list LAY)))
)
(SETQ W (TBLNEXT "LAYER"))
)
(setq dcl_id (load_dialog (test_make_dcl)))
(setq do_what 3)
(while (> do_what 1)
(if (not (new_dialog "cmm" dcl_id))
(exit)
)
(mode_tile "lism" 2)
(start_list "lism" 2)
(mapcar 'add_list SSLAY)
(end_list)
(action_tile "selm" "(done_dialog 2)")
(action_tile "lism" "(setq value $value)")
(action_tile
"accept"
"(setq value (get_tile \"lism\"))(done_dialog 1)"
)
(setq do_what (start_dialog))
(if (= 2 do_what)
(setq ss (ssget))
)
)
(unload_dialog dcl_id)
(if (= 1 do_what)
(progn
(setq lenth (read value)
clayer (nth lenth sslay)
)
(setq tbl (tblsearch "layer" clayer))
(if (not (null tbl))
(command "_chprop" ss "" "la" clayer "")
)
)
)
(princ)
)
(defun test_make_dcl (/ lst_str str file f)
(setq lst_str
(list
"cmm:dialog {"
" height = 20 ;"
" label = \"选择物体改变其图层\" ;"
" :list_box {"
" fixed_width_font = true ;"
" height = 20 ;"
" key = \"lism\" ;"
" label = \"图层名称选单:\" ;"
" }"
" ok_cancel;"
"}"
)
)
(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
)

(defun c:test (/ os ce bm ss se la) 
  (setvar "cmdecho" 0) 
  (setq ss (ssget)) 
  (if (not (null ss)) 
    (mpcm) 
  ) 
  (princ) 
) 
(defun mpcm (/             w             lay     sslay   dcl_id  do_what value 
             tbl     lism    selm    lenth   layer   clayer  num 
             a             b             no             tem_list             cood 
            ) 
  (SETQ W (TBLNEXT "LAYER" T)) 
  (WHILE (/= NIL W) 
    (SETQ LAY (CDR (ASSOC 2 W))) 
    (if        (/= (STRCASE lay) "DEFPOINTS") 
      (SETQ SSLAY (append SSLAY (list LAY))) 
    ) 
    (SETQ W (TBLNEXT "LAYER")) 
  ) 
  (setq dcl_id (load_dialog (test_make_dcl))) 
  (setq do_what 3) 
  (while (> do_what 1) 
    (if        (not (new_dialog "cmm" dcl_id)) 
      (exit) 
    ) 
    (mode_tile "lism" 2) 
    (start_list "lism" 2) 
    (mapcar 'add_list SSLAY) 
    (end_list) 
    (action_tile "selm" "(done_dialog 2)") 
    (action_tile "lism" "(setq value $value)") 
    (action_tile 
      "accept" 
      "(setq value (get_tile \"lism\"))(done_dialog 1)" 
    ) 
    (setq do_what (start_dialog)) 
    (if        (= 2 do_what) 
      (setq ss (ssget)) 
    ) 
  ) 
  (unload_dialog dcl_id) 
  (if (= 1 do_what) 
    (progn 
      (setq lenth  (read value) 
            clayer (nth lenth sslay) 
      ) 
      (setq tbl (tblsearch "layer" clayer)) 
      (if (not (null tbl)) 
        (command "_chprop" ss "" "la" clayer "") 
      ) 
    ) 
  ) 
  (princ) 
) 
(defun test_make_dcl (/ lst_str str file f) 
  (setq        lst_str 
         (list 
           "cmm:dialog {" 
           "     height = 20 ;" 
           "     label = \"选择物体改变其图层\" ;" 
           "     :list_box {" 
           "         fixed_width_font = true ;" 
           "         height = 20 ;" 
           "         key = \"lism\" ;" 
           "         label = \"图层名称选单:\" ;" 
           "     }" 
           "     ok_cancel;" 
           "}" 
          ) 
  ) 
  (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 
)

FT272296734 · 发表于 2015-2-4 10:15:39

太感谢{:soso_e100:}

flfcegu168 · 发表于 2018-11-14 14:10:03

账号		自动登录	找回密码
密码			立即注册

[求助] 怎么把DCL合并到LISP中

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。