求大神帮忙合并下这个对话框

ucuc2003 · 发表于 2013-7-2 11:34:08

本帖最后由 ucuc2003 于 2013-7-6 06:36 编辑

各位大侠，我想学习下，怎样把LSP和DCL合并到一起，
求大侠帮忙下，把下面的两个程序合并到一起，谢谢了!

我想对比一下: 合并前和合并后有什么区别，是怎么合并的

这是LSP：
(defun newerr()
  (setq *error* olderr esel nil edata nil d nil new nil do nil ss nil name nil)
  (command "undo" "e")
  (princ)
)
(defun c:TT2 (/ esel edata enme id new do ss name)
  (setq olderr *error* *error* newerr)
  (gc)
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq esel (nentsel "\n选择文字"))
  (setq edata (entget (car esel)))
  (if
(and
   (> (length esel) 2)
   (= (cdr (assoc 0 (entget (car esel)))) "MTEXT")
   (= (cdr (assoc 0 (entget (car (last esel))))) "DIMENSION")
)
(setq enme (car (last esel)) edata (entget enme))
  )
  (cond
(
   (or
(= (cdr (assoc 0 edata)) "TEXT")
      (= (cdr (assoc 0 edata)) "MTEXT")
      (= (cdr (assoc 0 edata)) "DIMENSION")
      (= (cdr (assoc 0 edata)) "ATTRIB")
      (= (cdr (assoc 0 edata)) "ATTDEF")
   )
   (if (> (setq id (load_dialog "wz.dcl")) 0)
      (if (new_dialog "edit" id)
      (progn
   (cond
            (
            (= (cdr (assoc 0 edata)) "DIMENSION")
            (set_tile "edit" (vl-string-subst  "" "\\A1;" (cdr (assoc 1 (entget (car esel))))))
            (set_tile "error" "尺寸文字")
            )
            (
            (and (> (length esel) 2)(= (cdr (assoc 0 (entget (car (last esel))))) "INSERT"))
            (set_tile "edit" (cdr (assoc 1 edata)))
            (set_tile "error" "块中文字")
            )
            (
            (and (= (length esel) 2)(= (cdr (assoc 0 (entget (car esel)))) "TEXT"))
            (set_tile "edit" (cdr (assoc 1 edata)))
            (set_tile "error" "普通文字")
            )
            (
            (and (= (length esel) 2)(= (cdr (assoc 0 (entget (car esel)))) "MTEXT"))
            (set_tile "edit" (cdr (assoc 1 edata)))
            (set_tile "error" "段落文字")
            )
            (
            (and (= (length esel) 2)(= (cdr (assoc 0 (entget (car esel)))) "ATTRIB"))
            (set_tile "edit" (cdr (assoc 1 edata)))
            (set_tile "error" "属性文字")
            )
            (
            (and (= (length esel) 2)(= (cdr (assoc 0 (entget (car esel)))) "ATTDEF"))
            (set_tile "edit" (cdr (assoc 2 edata)))
            (set_tile "error" "属性定义")
            )
         )
         (mode_tile "edit" 2)
         (action_tile "edit" "(setq new $value)")
         (action_tile "accept" "(setq result T)(done_dialog 1)")
         (action_tile "cancel" "(done_dialog 0)")
         (start_dialog)
      )
      )
   )
   (unload_dialog id)
   (if result
      (progn
      (if (= (cdr (assoc 0 (entget (car esel)))) "ATTDEF")
   (setq edata (subst (cons 2 new) (assoc 2 edata) edata))
   (setq edata (subst (cons 1 new) (assoc 1 edata) edata))
      )
      (entmod edata)
      (if (and (> (length esel) 2)(= (cdr (assoc 0 (entget (car (last esel))))) "INSERT"))
         (progn
            (setq name (cdr (assoc 2 (entget (car (last esel))))))
            (setq ss (ssget "x" '((0 . "insert"))) n 0)
            (repeat (sslength ss)
            (setq esel (ssname ss n) n (1+ n))
            (if (= (cdr (assoc 2 (entget esel))) name)(entupd esel))
            )
         )
         (entupd (car esel))
      )
      )
   )
)
(T (princ "\n不是文字"))
  )
  (newerr)
)

这是DCL

edit:dialog
{
  label="超级文字编辑";
  :edit_box
  {
label="文字:";
key="edit";
edit_width=40;
allow_accept=true;
  }
  :row
  {
spacer;
:errtile
{
   width=14;
}
ok_cancel;
  }
  spacer;
}

hao3ren · 发表于 2013-7-2 11:56:40

用的yxp大侠的dcl2lsp，论坛收一下

1993063 · 发表于 2013-7-2 11:56:41

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=92336

ucuc2003 · 发表于 2013-7-2 12:07:09

hao3ren 发表于 2013-7-6 06:56
用的yxp大侠的dcl2lsp，论坛收一下

感谢老大给我指条明路！

ucuc2003 · 发表于 2013-7-2 12:09:00

1993063 发表于 2013-7-6 06:56
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=92336

感谢老大给我指了条明路！

ucuc2003 · 发表于 2013-7-2 17:34:45

hao3ren 发表于 2013-7-6 06:56
用的yxp大侠的dcl2lsp，论坛收一下

问一下，程序运行后会在电脑里面产生一个DCL垃圾文件，请问在最后面加上什么，可以在程序运行完自动删除DCL文件？

hao3ren · 发表于 2013-7-2 17:54:06

(vl-file-delete "wz.dcl")

ucuc2003 · 发表于 2013-7-2 18:02:23

hao3ren 发表于 2013-7-6 12:54
(vl-file-delete "wz.dcl")

太感谢热心的hao3ren了！测试好了！程序运行后没有DCL了！！

song宋_74729 · 发表于 2022-6-23 11:25:07

==================================================================

(setq dcl_file (open (setq tmp-dcl-file-name (vl-filename-mktemp nil nil  ".DCL")) "w"))
            (progn
               (foreach x
               '(

                  "edit:dialog"
                  "{"
                  "  label=\"超级文字编辑\";"
                  "  :edit_box"
                  "  {"
                  " label=\"文字:\";"
                  " key=\"edit\";"
                  " edit_width=40;"
                  " allow_accept=true;"
                  "  }"
                  "  :row"
                  "  {"
                  " spacer;"
                  " :errtile"
                  " {"
                  "    width=14;"
                  " }"
                  " ok_cancel;"
                  "  }"
                  "  spacer;"
                  "}"
   ) (write-line x dcl_file) )
   (setq dcl_file (close dcl_file)))

(defun newerr()
  (setq *error* olderr esel nil edata nil d nil new nil do nil ss nil name nil)
  (command "undo" "e")
  (princ)
)

(defun c:wz(/ esel edata enme id new do ss name)
  (setq olderr *error* *error* newerr)
  (gc)
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq esel (nentsel "\n选择文字"))
  (setq edata (entget (car esel)))
  (if
(and
   (> (length esel) 2)
   (= (cdr (assoc 0 (entget (car esel)))) "MTEXT")
   (= (cdr (assoc 0 (entget (car (last esel))))) "DIMENSION")
)
(setq enme (car (last esel)) edata (entget enme))
  )
  (cond
(
   (or
(= (cdr (assoc 0 edata)) "TEXT")
      (= (cdr (assoc 0 edata)) "MTEXT")
      (= (cdr (assoc 0 edata)) "DIMENSION")
      (= (cdr (assoc 0 edata)) "ATTRIB")
      (= (cdr (assoc 0 edata)) "ATTDEF")
   )
   (if (> (setq id (load_dialog tmp-dcl-file-name)) 0)
      (if (new_dialog "edit" id)
      (progn
      (cond
            (
            (= (cdr (assoc 0 edata)) "DIMENSION")
            (set_tile "edit" (vl-string-subst  "" "\\A1;" (cdr (assoc 1 (entget (car esel))))))
            (set_tile "error" "尺寸文字")
            )
            (
            (and (> (length esel) 2)(= (cdr (assoc 0 (entget (car (last esel))))) "INSERT"))
            (set_tile "edit" (cdr (assoc 1 edata)))
            (set_tile "error" "块中文字")
            )
            (
            (and (= (length esel) 2)(= (cdr (assoc 0 (entget (car esel)))) "TEXT"))
            (set_tile "edit" (cdr (assoc 1 edata)))
            (set_tile "error" "普通文字")
            )
            (
            (and (= (length esel) 2)(= (cdr (assoc 0 (entget (car esel)))) "MTEXT"))
            (set_tile "edit" (cdr (assoc 1 edata)))
            (set_tile "error" "段落文字")
            )
            (
            (and (= (length esel) 2)(= (cdr (assoc 0 (entget (car esel)))) "ATTRIB"))
            (set_tile "edit" (cdr (assoc 1 edata)))
            (set_tile "error" "属性文字")
            )
            (
            (and (= (length esel) 2)(= (cdr (assoc 0 (entget (car esel)))) "ATTDEF"))
            (set_tile "edit" (cdr (assoc 2 edata)))
            (set_tile "error" "属性定义")
            )
         )
         (mode_tile "edit" 2)
         (action_tile "edit" "(setq new $value)")
         (action_tile "accept" "(setq result T)(done_dialog 1)")
         (action_tile "cancel" "(done_dialog 0)")
         (start_dialog)
      )
      )
   )
   (unload_dialog id)
   (if result
      (progn
      (if (= (cdr (assoc 0 (entget (car esel)))) "ATTDEF")
      (setq edata (subst (cons 2 new) (assoc 2 edata) edata))
      (setq edata (subst (cons 1 new) (assoc 1 edata) edata))
      )
      (entmod edata)
      (if (and (> (length esel) 2)(= (cdr (assoc 0 (entget (car (last esel))))) "INSERT"))
         (progn
            (setq name (cdr (assoc 2 (entget (car (last esel))))))
            (setq ss (ssget "x" '((0 . "insert"))) n 0)
            (repeat (sslength ss)
            (setq esel (ssname ss n) n (1+ n))
            (if (= (cdr (assoc 2 (entget esel))) name)(entupd esel))
            )
         )
         (entupd (car esel))
      )
      )
   )
)
(T (princ "\n不是文字"))
  )
  (newerr)
)

试试这参考看看

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

[已解答] 求大神帮忙合并下这个对话框

本帖子中包含更多资源

相关帖子

本帖子中包含更多资源

评分

评分