層復制

spring

现在我想把对话框 [ca1.dcl] 改成如下 [ca2.dcl]﹕

                  

  如果我同时选中[上固定板] [上卸料板]﹐然后将图复制到
[上固定板] [上卸料板]﹐程序要怎么改呢？
;;;;;;;;;;;;;;;;;;;;;;;
(defun *error* (laynot)
  (setq        laynot
         (prompt
           (strcat "Cannot find layer <" lay "> ")
         )
  )
)
(defun cc ()
  (setq        acDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        lays  (vla-get-Layers acDoc)
  )
  (setq ssd (ssget))
  (if ssd
    (progn
      (if (tblobjname "LAYER" lay)
        (progn                                ;已存在
          (setq vvlay (vla-Item lays lay))
          (if (= (vla-get-Freeze vvlay) :vlax-true)
            (vla-put-Freeze vvlay :vlax-false) ;解凍
          )
          (if (= (vla-get-Lock vvlay) :vlax-true)
            (vla-put-Lock vvlay :vlax-false) ;解鎖
          )
          (if (= (vla-get-LayerOn vvlay) :vlax-false)
            (vla-put-LayerOn vvlay :vlax-true) ;可見
          )
        )
        (*error*)
      )
      (command "copy" ssd "" "0,0" "0,0")
      (command "change" ssd "" "p" "layer" lay "")
    )
  )
)
;;;__________________________________________________________________________________
(defun c:ca2 (/ dot dq)
  (VL-LOAD-COM)
  (setq cm (getvar "cmdecho"))
  (setvar "cmdecho" 0)
;;;__________________________________________________________________________________
  (setq dot 4)
  (SETQ lay "H")
  (SETQ Dq (LOAD_DIALOG "ca1.DCL"))
  (while (> dot 1)
    (if        (new_dialog "ca1" dq)
      (progn
        (foreach d '("H" "S" "DIE")
          (action_tile d "(setq lay $key)")
        )
        (set_tile lay "1")
        (action_tile "se" "(done_dialog 3)")
        (action_tile "view1" "(done_dialog 2)")
        (action_tile "cancel" "(done_dialog 0)")
        (setq dot (start_dialog))
        (cond
          ((= 3 dot) (cc))
        )
      )
    )
  )
  (unload_dialog dq)
  (setvar "cmdecho" cm)
  (princ)
)

meflying

可以参照系统一些参数设定，
将选择[上固定板]选中付给某一变量1，不选中付0。
将选择[上卸料板]选中付给另一变量2，不选中付0。
然后将两个变量加起来，如果是1，就复制固定板，如果是2就复制卸料板，如果是3就两个都复制。

三个也可以用此方法。
不过我看你的程序好象有问题（没调，随便看了一下），那个lay是不是该加上引号？

spring

謝謝!!!可是我不懂得 LISP 你能幫我改一下嗎????

meflying

你这样弄个别人的程序来，又不说明具体内容，是很不好改的。
而且原来的程序也有问题，对话框动作也不完全对，
你如果想别人给你做个小功能，还是把具体要求说说吧，如果你会LISP的话，还可以让别人看看你的程序

spring

上次是前生幫我寫的,上次我跟他說了.可是到現在也沒回音,可能是他最近比較忙.這個程式可以幫我畫圖速度提高好多,你幫我改一下好嗎!!!小弟在此謝過了.

spring

;;;程序名称: 层复制_______________________________________
;;;程序提供: 龙龙仔&前生__________________________________
;;;2003.06.05_____________________________________________
(defun CCO (/ SS LAY)
  (setq cm (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (vl-load-com)
  (setq        acDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        lays  (vla-get-Layers acDoc)
  )
  (setq ss (ssget))
  (if SS
    (progn
      (while (/= lay "")
        (setq LAY (getstring "\n请输入层名 / <ENTER结束命令>: "))
        (if (and (/= "" LAY) (tblsearch "LAYER" LAY))
          (progn
            (setq vvlay (vla-Item lays lay))
            (if        (= (vla-get-Freeze vvlay) :vlax-true)
              (vla-put-Freeze vvlay :vlax-false) ;解冻
            )
            (if        (= (vla-get-Lock vvlay) :vlax-true)
              (vla-put-Lock vvlay :vlax-false) ;解锁
            )
            (if        (= (vla-get-LayerOn vvlay) :vlax-false)
              (vla-put-LayerOn vvlay :vlax-true) ;可见
            )
            (setq ss1 (ssget "p"))
            (command "_.copy" SS "" "0,0" "0,0")
            (command "_.change" SS1 "" "_p" "_la" LAY "")
            (prompt
              (strcat "\n"
                      (itoa (sslength SS))
                      " 对象拷贝到 "
                      LAY
                      " 层 "
              )
            )
          )
          (prompt
            (strcat "\n输入的图层名称不存在! layer name=" lay " ")
          )
        )
      )
    )
  )
  (setvar "cmdecho" cm)
  (princ)
)
;;;_______________________________________________________
;;;上面的程序是让使用者在命令行中输入指定的图层名称,然后将选中的圖元复制到指定的图层中(可多重复制).
;;;我是搞冷冲模设计的,因为模具的图层是固定死的,所以我想做个对话框,如果我同时选中[上夹板(PH)]和[上卸料板(PS)]时,程序将圖元复制到         [上夹板(PH)]和       [上卸料板(PS)]图层

前生

兄弟.这样吧.我也是做冲压模具设计发方面工作的,有什么需要.看我能不能
彻底的帮帮你?
给我你的有邮件先
OursCAD@21cn.com
atcad@mjtd.com

前生

(DEFUN C:ca (/ cl n x ly c lyr dh what_next)
;;;__________________________________
  (DEFUN SETLA ()
    (setq lyr (subst (Cons k (read rtn)) (assoc k lyr) lyr))
    (COND
      ((= "udh" k) (setq udh rtn))
      ((= "upb" k) (setq upb rtn))
      ((= "upp" k) (setq upp rtn))
      ((= "usb" k) (setq usb rtn))
      ((= "usp" k) (setq usp rtn))
      ((= "ddp" k) (setq ddp rtn))
      ((= "ddb" k) (setq ddb rtn))
      ((= "ddh" k) (setq ddh rtn))
    )
    (set_tile "yes" "0")
    (set_tile "no" "0")

    (setq lly nil)
    (setq p (cdr (Assoc "udh" lyr)))
    (if        (= 1 p)
      (setq lly (cons "udh" lly))
    )
    (setq p nil)
    (setq p (cdr (Assoc "upb" lyr)))
    (if        (= 1 p)
      (setq lly (cons "upb" lly))
    )
    (setq p nil)
    (setq p (cdr (Assoc "upp" lyr)))
    (if        (= 1 p)
      (setq lly (cons "upp" lly))
    )
    (setq p nil)
    (setq p (cdr (Assoc "usb" lyr)))
    (if        (= 1 p)
      (setq lly (cons "usb" lly))
    )
    (setq p nil)
    (setq p (cdr (Assoc "usp" lyr)))
    (if        (= 1 p)
      (setq lly (cons "usp" lly))
    )
    (setq p nil)
    (setq p (cdr (Assoc "ddp" lyr)))
    (if        (= 1 p)
      (setq lly (cons "ddp" lly))
    )
    (setq p nil)
    (setq p (cdr (Assoc "ddb" lyr)))
    (if        (= 1 p)
      (setq lly (cons "ddb" lly))
    )
    (setq p nil)
    (setq p (cdr (Assoc "ddh" lyr)))
    (if        (= 1 p)
      (setq lly (cons "ddh" lly))
    )
    (setq p nil)
    (set_tile "t2" (vl-prin1-to-string lly))
    (princ)
  )
;;;_____________________________________
  (defun put ()
    (setq lly nil)
    (setq udh (cdr (Assoc "udh" lyr)))
    (if        (= 1 udh)
      (setq lly (cons "udh" lly))
    )
    (setq upb (cdr (Assoc "upb" lyr)))
    (if        (= 1 upb)
      (setq lly (cons "upb" lly))
    )
    (setq upp (cdr (Assoc "upp" lyr)))
    (if        (= 1 upp)
      (setq lly (cons "upp" lly))
    )
    (setq usb (cdr (Assoc "usb" lyr)))
    (if        (= 1 usb)
      (setq lly (cons "usb" lly))
    )
    (setq usp (cdr (Assoc "usp" lyr)))
    (if        (= 1 usp)
      (setq lly (cons "usp" lly))
    )
    (setq ddp (cdr (Assoc "ddp" lyr)))
    (if        (= 1 ddp)
      (setq lly (cons "ddp" lly))
    )
    (setq ddb (cdr (Assoc "ddb" lyr)))
    (if        (= 1 ddb)
      (setq lly (cons "ddb" lly))
    )
    (setq ddh (cdr (Assoc "ddh" lyr)))
    (if        (= 1 ddh)
      (setq lly (cons "ddh" lly))
    )
    (setq udh nil
          upb nil
          upp nil
          usb nil
          usp nil
          ddp nil
          ddb nil
          ddh nil
          lyr nil
    )
    (if        (> (length lly) 0)
      (progn
        (setq conut 0)
        (while (< count (sslength scir))
          (setq en (ssname scir count))
          (setq count (1+ count))
          (setq ed (entget en))
          (setq cou 0)
          (while (< cou (length lly))
            (setq lay (nth cou lly))
            (setq cou (1+ cou))
            (setq ed (subst (cons 8 lay) (Assoc 8 ed) ed))
            (entmake ed)
          )
        )
      )
    )
    (setq lly nil
          count        nil
          cou nil
          en nil
          ed nil
          lay nil
    )
  )                                        ;
;;;_____________________________________
  (defun se ()
    (setq scir nil)
    (PROMPT
      "\n ___ 请选择需要改变图层的实体...请稍侯.."
    )
    (SETQ SCIR (SSGET))
    (setq count 0)
    (if        scir
      (setq kg 0)
      (setq kg 1)
    )
    (while (getpoint "\n 回车或空格返回图蹭设定设定界面!"))
  )
;;;_____________________________________
  (defun mody ()
    (setq udh "1"
          upb "1"
          upp "1"
          usb "1"
          usp "1"
          ddp "1"
          ddb "1"
          ddh "1"
    )
    (set_tile "udh" udh)
    (set_tile "upb" upb)
    (set_tile "upp" upp)
    (set_tile "usb" usb)
    (set_tile "usp" usp)
    (set_tile "ddp" ddp)
    (set_tile "ddb" ddb)
    (set_tile "ddh" ddh)
    (setq lyr (list
                (Cons "udh" 1)
                (Cons "upb" 1)
                (Cons "upp" 1)
                (Cons "usb" 1)
                (Cons "usp" 1)
                (Cons "ddp" 1)
                (Cons "ddb" 1)
                (Cons "ddh" 1)
              )
    )
    (setq lly (list "udh" "upb" "upp" "usb" "usp" "ddp" "ddb" "ddh"))
    (set_tile "t2" (vl-prin1-to-string lly))

  )
;;;_____________________________________
  (defun modn ()
    (setq udh "0"
          upb "0"
          upp "0"
          usb "0"
          usp "0"
          ddp "0"
          ddb "0"
          ddh "0"
    )
    (set_tile "udh" udh)
    (set_tile "upb" upb)
    (set_tile "upp" upp)
    (set_tile "usb" usb)
    (set_tile "usp" usp)
    (set_tile "ddp" ddp)
    (set_tile "ddb" ddb)
    (set_tile "ddh" ddh)
    (setq lyr (list
                (Cons "udh" 0)
                (Cons "upb" 0)
                (Cons "upp" 0)
                (Cons "usb" 0)
                (Cons "usp" 0)
                (Cons "ddp" 0)
                (Cons "ddb" 0)
                (Cons "ddh" 0)
              )
    )
    (set_tile "t2" "图层全部不选")
  )
;;;_____________________________________
  (setq        udh "0"
        upb "0"
        upp "0"
        usb "0"
        usp "0"
        ddp "0"
        ddb "0"
        ddh "0"
  )
  (setq kg 1)
;;;  )
  (setq        lyr (list
              (Cons "udh" 0)
              (Cons "upb" 0)
              (Cons "upp" 0)
              (Cons "usb" 0)
              (Cons "usp" 0)
              (Cons "ddp" 0)
              (Cons "ddb" 0)
              (Cons "ddh" 0)
            )
  )
;;;_____________________________________
  (if (> (SETQ DH (LOAD_DIALOG "atcad")) 0)
    (progn
      (setq what_next 4)                ;
      (while (> what_next 1)
        (if (new_dialog "oursl" dh)        ;if2
          (progn
            (setdate "t1")
            (start_image "cc")
            (slide_image
              0
              0
              (dimx_tile "cc")
              (dimy_tile "cc")
              "atcad(atjm)"
            )
            (end_image)
            (set_tile "udh" udh)
            (set_tile "upb" upb)
            (set_tile "upp" upp)
            (set_tile "usb" usb)
            (set_tile "usp" usp)
            (set_tile "ddp" ddp)
            (set_tile "ddb" ddb)
            (set_tile "ddh" ddh)
            (action_tile "udh" "(setq k $key)(setq rtn $value)(setla)")
            (action_tile "upb" "(setq k $key)(setq rtn $value)(setla)")
            (action_tile "upp" "(setq k $key)(setq rtn $value)(setla)")
            (action_tile "usb" "(setq k $key)(setq rtn $value)(setla)")
            (action_tile "usp" "(setq k $key)(setq rtn $value)(setla)")
            (action_tile "ddp" "(setq k $key)(setq rtn $value)(setla)")
            (action_tile "ddb" "(setq k $key)(setq rtn $value)(setla)")
            (action_tile "ddh" "(setq k $key)(setq rtn $value)(setla)")
            (set_tile "t3" "layer-atcad.dcl<oursl>")
            (mode_tile "accept" kg)
            (action_tile "se" "(done_dialog 3)")
            (action_tile "yes" "(mody)")
            (action_tile "no" "(modn)")
            (action_tile "cancel" "(done_dialog 0)")
            (action_tile "accept" "(done_dialog 1)")
            (setq what_next (start_dialog))
            (cond
              ((= 1 what_next) (put))
              ((= 3 what_next) (Se))
            )
          )
          (progn
            (prompt "不能显示对话框!...")
            (setq what_next 0)
          )
        )
      )
      (unload_dialog dh)
    )
    (prompt "不能显示对话框!...")
  )
  (prompt "     ___layer.")
  (princ)
)

前生

oursl:dialog {
             label="  ※※模具图层小助手※※ ";
            :image{color=5;height=0.05;}
            :text{key="t3";alignment=centered;}
            :image{color=5;height=0.05;}
             spacer_1;
             :row{
             spacer_1;
             spacer_1;
             :column {
                       :toggle {label="UDH";key="udh";}
                       :toggle {label="UPB";key="upb";}
                       :toggle {label="UPP";key="upp";}
                       :toggle {label="USB";key="usb";}
                       }
             spacer_1;
             :column {
                       :toggle {label="USP";key="usp";}
                       :toggle {label="DDP";key="ddp";}
                       :toggle {label="DDB";key="ddb";}
                       :toggle {label="DDH";key="ddh";}
                       }
             spacer_1;
             :image_button {alignment=top;width=25;aspect_ratio =0.6;color=0;key="cc";}
             spacer_1;
             spacer_1;
             spacer_1;
                       }
              :row{
                 :radio_button{label="图层全选";key="yes";}
                 :radio_button{label="全部不选";key="no";}
                  }
                 :text{key="t2";alignment=centered;}
            spacer_1;
                :image{color=1;height=0.05;}
                :text{key="t1";alignment=centered;}
                :image{color=1;height=0.05;}
            :row{
             :button{label="选择实体";key="se";width=5;}
             ok_cancel;
             }
          }

前生

怎么了?贴图不能上传了