请教一个自动选择和循环执行的问题

artken · 发表于 2008-8-4 13:26

本帖最后由作者于 2008-8-4 13:59:14 编辑

下面这种程序是ET工具里的，作用是：执行---》提示用户选择物体-----》将用户选择的属性块及动态块分解。
能不能改为全自动过程，不需要人工干预，也就是：执行后，自动选择所有对象(相当于输入all)，不用人去选择物体。好像是代码中的这句：(Setq SS1 (SsGet (list (cons 0 "INSERT")(cons 67 PSFLAG))))
希望模型空间和布局空间的都可以一次处理，原程序是如果在布局空间执行就处理不了模型空间的。(这个如果不好弄就不考虑了)
另外：如果文件大的话，其实这个过程是很费时的，总担心执行到一半就死了。能不能自动循环执行，比如：先自动处理布局空间的所有属性块，休息3秒，然后自动选择模型空间的LAY1层上的所有动态块执行，休息3秒，然后自动选择LAY2层上的动态块执行分解，休息3秒，然后选择所LAY3图上的属性块执行分解。代码最好是能够方便增加或修改这个循环执行.....
（如果实在不好弄的话，就不管动态块了，只处理属性块。）
这样，人可以走开，等一会回来收图就是了。
哪位大侠能不能帮一下忙。。。（这种要求不知会不会有点过份....如果没时间帮忙全部，就帮忙局部，谢谢啊，或给些例子参考一下，只是我不什么编程基本，哎）

(Defun C:BURST (/ item bitset bump att-text lastent burst-one burst
BCNT BLAYER BCOLOR ELAST BLTYPE ETYPE PSFLAG ENAME )
;-----------------------------------------------------
; Item from association list
;-----------------------------------------------------
(Defun ITEM (N E) (CDR (Assoc N E)))
;-----------------------------------------------------
; Error Handler
;-----------------------------------------------------
(acet-error-init
(list
(list "cmdecho" 0
"highlight" 1
)
T ;flag. True means use undo for error clean up.
);list
);acet-error-init
;-----------------------------------------------------
; BIT SET
;-----------------------------------------------------
(Defun BITSET (A B) (= (Boole 1 A B) B))
;-----------------------------------------------------
; BUMP
;-----------------------------------------------------
(Setq bcnt 0)
(Defun bump (prmpt)
(Princ
(Nth bcnt '("\r-" "\r\" "\r|" "\r/"))
)
(Setq bcnt (Rem (1+ bcnt) 4))
)
;-----------------------------------------------------
; Convert Attribute Entity to Text Entity or MText Entity
;-----------------------------------------------------
(Defun ATT-TEXT (AENT / ANAME TENT ILIST INUM)
(setq ANAME (cdr (assoc -1 AENT)))
(if (_MATTS_UTIL ANAME)
(progn
; Multiple Line Text Attributes (MATTS) -
; make an MTEXT entity from the MATTS data
(_MATTS_UTIL ANAME 1)
)
(progn
; else -Single line attribute conversion
(Setq TENT '((0 . "TEXT")))
(ForEach INUM '(8
6
38
39
62
67
210
10
40
1
50
41
51
7
71
72
73
11
74
)
(If (Setq ILIST (Assoc INUM AENT))
(Setq TENT (Cons ILIST TENT))
)
)
(Setq
tent (Subst
(Cons 73 (item 74 aent))
(Assoc 74 tent)
tent
)
)
(EntMake (Reverse TENT))
)
)
)
;-----------------------------------------------------
; Find True last entity
;-----------------------------------------------------
(Defun LASTENT (/ E0 EN)
(Setq E0 (EntLast))
(While (Setq EN (EntNext E0))
(Setq E0 EN)
)
E0
)
;-----------------------------------------------------
; See if a block is explodable. Return T if it is,
; otherwise return nil
;-----------------------------------------------------
(Defun EXPLODABLE (BNAME / B expld)
(vl-load-com)
(setq BLOCKS (vla-get-blocks
(vla-get-ActiveDocument (vlax-get-acad-object)))
)
(vlax-for B BLOCKS (if (and (= :vlax-false (vla-get-islayout B))
(= (strcase (vla-get-name B)) (strcase BNAME)))
(setq expld (= :vlax-true (vla-get-explodable B)))
)
)
expld
)
;-----------------------------------------------------
; Burst one entity
;-----------------------------------------------------
(Defun BURST-ONE (BNAME / BENT ANAME ENT ATYPE AENT AGAIN ENAME
ENT BBLOCK SS-COLOR SS-LAYER SS-LTYPE mirror ss-mirror
mlast)
(Setq
BENT (EntGet BNAME)
BLAYER (ITEM 8 BENT)
BCOLOR (ITEM 62 BENT)
BBLOCK (ITEM 2 BENT)
BCOLOR (Cond
((> BCOLOR 0) BCOLOR)
((= BCOLOR 0) "BYBLOCK")
("BYLAYER")
)
BLTYPE (Cond ((ITEM 6 BENT)) ("BYLAYER"))
)
(Setq ELAST (LASTENT))
(If (and (EXPLODABLE BBLOCK) (= 1 (ITEM 66 BENT)))
(Progn
(Setq ANAME BNAME)
(While (Setq
ANAME (EntNext ANAME)
AENT (EntGet ANAME)
ATYPE (ITEM 0 AENT)
AGAIN (= "ATTRIB" ATYPE)
)
(bump "Converting attributes")
(ATT-TEXT AENT)
)
)
)
(Progn
(bump "Exploding block")
(acet-explode BNAME)
;(command "_.explode" bname)
)
(Setq
SS-LAYER (SsAdd)
SS-COLOR (SsAdd)
SS-LTYPE (SsAdd)
ENAME ELAST
)
(While (Setq ENAME (EntNext ENAME))
(bump "Gathering pieces")
(Setq
ENT (EntGet ENAME)
ETYPE (ITEM 0 ENT)
)
(If (= "ATTDEF" ETYPE)
(Progn
(If (BITSET (ITEM 70 ENT) 2)
(ATT-TEXT ENT)
)
(EntDel ENAME)
)
(Progn
(If (= "0" (ITEM 8 ENT))
(SsAdd ENAME SS-LAYER)
)
(If (= 0 (ITEM 62 ENT))
(SsAdd ENAME SS-COLOR)
)
(If (= "BYBLOCK" (ITEM 6 ENT))
(SsAdd ENAME SS-LTYPE)
)
)
)
)
(If (> (SsLength SS-LAYER) 0)
(Progn
(bump "Fixing layers")
(Command
"_.chprop" SS-LAYER "" "_LA" BLAYER ""
)
)
)
(If (> (SsLength SS-COLOR) 0)
(Progn
(bump "Fixing colors")
(Command
"_.chprop" SS-COLOR "" "_C" BCOLOR ""
)
)
)
(If (> (SsLength SS-LTYPE) 0)
(Progn
(bump "Fixing linetypes")
(Command
"_.chprop" SS-LTYPE "" "_LT" BLTYPE ""
)
)
)
)
;-----------------------------------------------------
; BURST MAIN ROUTINE
;-----------------------------------------------------
(Defun BURST (/ SS1)
(setq PSFLAG (if (= 1 (caar (vports)))
1 0
)
)
(Setq SS1 (SsGet (list (cons 0 "INSERT")(cons 67 PSFLAG))))
(If SS1
(Progn
(Setvar "highlight" 0)
(terpri)
(Repeat
(SsLength SS1)
(Setq ENAME (SsName SS1 0))
(SsDel ENAME SS1)
(BURST-ONE ENAME)
)
(princ "\n")
)
)
)
;-----------------------------------------------------
; BURST COMMAND
;-----------------------------------------------------
(BURST)
(acet-error-restore)
);end defun
(princ)

(Defun C:BURST (/ item bitset bump att-text lastent burst-one burst
                  BCNT BLAYER BCOLOR ELAST BLTYPE ETYPE PSFLAG ENAME ) 
   ;-----------------------------------------------------
   ; Item from association list
   ;-----------------------------------------------------
   (Defun ITEM (N E) (CDR (Assoc N E)))
   ;-----------------------------------------------------
   ; Error Handler
   ;----------------------------------------------------- 
  (acet-error-init
    (list
      (list "cmdecho" 0
            "highlight" 1
      )
      T     ;flag. True means use undo for error clean up.
    );list
  );acet-error-init  
   ;-----------------------------------------------------
   ; BIT SET
   ;----------------------------------------------------- 
   (Defun BITSET (A B) (= (Boole 1 A B) B)) 
   ;-----------------------------------------------------
   ; BUMP
   ;----------------------------------------------------- 
   (Setq bcnt 0)
   (Defun bump (prmpt)
      (Princ
         (Nth bcnt '("\r-" "\r\" "\r|" "\r/"))
      )
      (Setq bcnt (Rem (1+ bcnt) 4))
   )
 
   ;-----------------------------------------------------
   ; Convert Attribute Entity to Text Entity or MText Entity
   ;-----------------------------------------------------
 
   (Defun ATT-TEXT (AENT / ANAME TENT ILIST INUM)
      (setq ANAME (cdr (assoc -1 AENT)))
      (if (_MATTS_UTIL ANAME)
         (progn
            ; Multiple Line Text Attributes (MATTS) -
            ; make an MTEXT entity from the MATTS data
            (_MATTS_UTIL ANAME 1)
         )
         (progn
            ; else -Single line attribute conversion
            (Setq TENT '((0 . "TEXT")))
            (ForEach INUM '(8
                            6
                            38
                            39
                            62
                            67
                            210
                            10
                            40
                            1
                            50
                            41
                            51
                            7
                            71
                            72
                            73
                            11
                            74
                           )
               (If (Setq ILIST (Assoc INUM AENT))
                   (Setq TENT (Cons ILIST TENT))
               )
            )
            (Setq
               tent (Subst
                       (Cons 73 (item 74 aent))
                       (Assoc 74 tent)
                       tent
                    )
            )
            (EntMake (Reverse TENT))
         )
      )
   ) 
   ;-----------------------------------------------------
   ; Find True last entity
   ;-----------------------------------------------------
 
   (Defun LASTENT (/ E0 EN)
      (Setq E0 (EntLast))
      (While (Setq EN (EntNext E0))
         (Setq E0 EN)
      )
      E0
   ) 
   ;-----------------------------------------------------
   ; See if a block is explodable. Return T if it is, 
   ; otherwise return nil
   ;----------------------------------------------------- 
   (Defun EXPLODABLE (BNAME / B expld)
      (vl-load-com)
      (setq BLOCKS (vla-get-blocks 
                     (vla-get-ActiveDocument (vlax-get-acad-object)))
       )
      
      (vlax-for B BLOCKS (if (and (= :vlax-false (vla-get-islayout B))
                                  (= (strcase (vla-get-name B)) (strcase BNAME)))
                      (setq expld (= :vlax-true (vla-get-explodable B)))
           )
       )
       expld
    )
   ;-----------------------------------------------------
   ; Burst one entity
   ;----------------------------------------------------- 
   (Defun BURST-ONE (BNAME / BENT ANAME ENT ATYPE AENT AGAIN ENAME
                     ENT BBLOCK SS-COLOR SS-LAYER SS-LTYPE mirror ss-mirror
                     mlast)
      (Setq
         BENT   (EntGet BNAME)
         BLAYER (ITEM 8 BENT)
         BCOLOR (ITEM 62 BENT)
         BBLOCK (ITEM 2 BENT)
         BCOLOR (Cond
                   ((> BCOLOR 0) BCOLOR)
                   ((= BCOLOR 0) "BYBLOCK")
                   ("BYLAYER")
                )
         BLTYPE (Cond ((ITEM 6 BENT)) ("BYLAYER"))
      )
      (Setq ELAST (LASTENT))
      (If (and (EXPLODABLE BBLOCK) (= 1 (ITEM 66 BENT)))
         (Progn
            (Setq ANAME BNAME)
            (While (Setq
                      ANAME (EntNext ANAME)
                      AENT  (EntGet ANAME)
                      ATYPE (ITEM 0 AENT)
                      AGAIN (= "ATTRIB" ATYPE)
                   )
               (bump "Converting attributes")
               (ATT-TEXT AENT)
            )
         )
      )
         (Progn
            (bump "Exploding block")
            (acet-explode BNAME)
            ;(command "_.explode" bname)
         )
      (Setq
         SS-LAYER (SsAdd)
         SS-COLOR (SsAdd)
         SS-LTYPE (SsAdd)
         ENAME    ELAST
      )
      (While (Setq ENAME (EntNext ENAME))
         (bump "Gathering pieces")
         (Setq
            ENT   (EntGet ENAME)
            ETYPE (ITEM 0 ENT)
         )
         (If (= "ATTDEF" ETYPE)
            (Progn
               (If (BITSET (ITEM 70 ENT) 2)
                  (ATT-TEXT ENT)
               )
               (EntDel ENAME)
            )
            (Progn
               (If (= "0" (ITEM 8 ENT))
                  (SsAdd ENAME SS-LAYER)
               )
               (If (= 0 (ITEM 62 ENT))
                  (SsAdd ENAME SS-COLOR)
               )
               (If (= "BYBLOCK" (ITEM 6 ENT))
                  (SsAdd ENAME SS-LTYPE)
               )
            )
         )
      )
      (If (> (SsLength SS-LAYER) 0)
         (Progn
            (bump "Fixing layers")
            (Command
               "_.chprop" SS-LAYER "" "_LA" BLAYER ""
            )
         )
      )
      (If (> (SsLength SS-COLOR) 0)
         (Progn
            (bump "Fixing colors")
            (Command
               "_.chprop" SS-COLOR "" "_C" BCOLOR ""
            )
         )
      )
      (If (> (SsLength SS-LTYPE) 0)
         (Progn
            (bump "Fixing linetypes")
            (Command
               "_.chprop" SS-LTYPE "" "_LT" BLTYPE ""
            )
         )
      )
   ) 
   ;-----------------------------------------------------
   ; BURST MAIN ROUTINE
   ;----------------------------------------------------- 
   (Defun BURST (/ SS1)
      (setq PSFLAG (if (= 1 (caar (vports)))
                       1 0
                   )
      )
      (Setq SS1 (SsGet (list (cons 0 "INSERT")(cons 67 PSFLAG))))
      (If SS1
         (Progn
            (Setvar "highlight" 0)
            (terpri)
            (Repeat
               (SsLength SS1)
               (Setq ENAME (SsName SS1 0))
               (SsDel ENAME SS1)
               (BURST-ONE ENAME)
            )
            (princ "\n")
         )
      )
   )
   ;-----------------------------------------------------
   ; BURST COMMAND
   ;----------------------------------------------------- 
   (BURST) 
  (acet-error-restore) 
);end defun
(princ)

ZZXXQQ · 发表于 2008-8-4 15:37

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

artken · 发表于 2008-8-4 22:06

谢谢

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