層復制

spring · 发表于 2003-6-17 20:45:00

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

  如果我同时选中[上固定板] [上卸料板]﹐然后将图复制到
[上固定板] [上卸料板]﹐程序要怎么改呢？
;;;;;;;;;;;;;;;;;;;;;;;
(defun *error* (laynot)
  (setq       laynot
      (prompt
         (strcat "Cannot find layer  ")
      )
  )
)
(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 &quotH")
  (SETQ Dq (LOAD_DIALOG "ca1.DCL"))
  (while (> dot 1)
(if       (new_dialog "ca1" dq)
   (progn
      (foreach d '(&quotH" &quotS" "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 · 发表于 2003-6-18 09:16:00

可以参照系统一些参数设定，
将选择[上固定板]选中付给某一变量1，不选中付0。
将选择[上卸料板]选中付给另一变量2，不选中付0。
然后将两个变量加起来，如果是1，就复制固定板，如果是2就复制卸料板，如果是3就两个都复制。
三个也可以用此方法。
不过我看你的程序好象有问题（没调，随便看了一下），那个lay是不是该加上引号？

spring · 发表于 2003-6-19 22:22:00

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

meflying · 发表于 2003-6-20 09:15:00

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

spring · 发表于 2003-6-20 20:54:00

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

spring · 发表于 2003-6-20 21:19:00

;;;程序名称: 层复制_______________________________________
;;;程序提供: 龙龙仔&前生__________________________________
;;;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请输入层名 / : "))
      (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)]图层

前生 · 发表于 2003-6-22 10:08:00

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

前生 · 发表于 2003-6-22 10:14:00

(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 ( (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")
         (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)
)

前生 · 发表于 2003-6-22 10:16:00

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;
         }
      }

前生 · 发表于 2003-6-22 10:20:00

怎么了?贴图不能上传了

層復制

发表回复

精选推荐