我想将选择的多层嵌套块不完全彻底打碎,即不打碎名为表中(list "DZ""DZZR""DZSX""DZZRSX")的块。代码如下,但运行过程中总是没有打碎到最后一层就停止了,请高手们分析一下原因,给点改进意见,谢谢!- (defun c:defa (/ LST LSTX SS X)
-  (setq ss   (ssget '((0 . "INSERT")))
-        lst  nil
-        lstx (list "DZ""DZZR""DZSX""DZZRSX");不打碎的块名列表
-  ) ;_ End setq
-  (mapcar '(lambda (x) (setq lst (append lst (list (cons 2 x))))) lstx)
-  (while    (setq ss (ssget    "_P"
-             (append    (list (cons -4 "<and")
-                       (cons 0 "INSERT")
-                       (cons -4 "<not")
-                       (cons -4 "<or")
-                 ) ;_ End list
-                 lst
-                 (list (cons -4 "or>")
-                       (cons -4 "not>")
-                       (cons -4 "and>")
-                 ) ;_ End list
-             ) ;_ End append
-          ) ;_ End ssget
-     ) ;_ End setq
-   (brkblk ss)
-  ) ;_ End while
- ) ;_ End defun
- (defun brkblk (ss / BNAME DD ENT ENT1 LST N NAME NEWTXT TCA ssa)
-  (REPEAT (SETQ N (SSLENGTH SS))
-   (SETQ ENT1 (SETQ ENT (ENTGET (SSNAME SS (SETQ N (1- N))))))
-   (if (= (get 66 ent1) 1)
-    (WHILE (/= (GET 0 (SETQ ENT1 (ENTGET (SETQ NAME (ENTNEXT (GET -1 ENT1)))))) "SEQEND")
-     (IF    (AND (= (GET 0 ENT1) "ATTRIB") (= (GET 70 ENT1) 1))
-      (SSSET ENT1 1 "")
-     ) ;_ End IF
-    ) ;_ End WHILE
-   ) ;_ End if
-  ) ;_ End REPEAT
-  (repeat (setq n (sslength ss))
-   (setq ent1 (entget (setq bname (ssname ss (setq n (1- n))))))
-   (setvar "clayer" (get 8 ent1))
-   (if (= (get 66 ent1) 1)
-    (while (/= (get 0 (setq ent1 (entget (setq name (entnext (get -1 ent1)))))) "SEQEND")
-     (if    (= (get 0 ent1) "ATTRIB")
-      (progn
-       (setq newtxt '((0 . "TEXT")))
-       (setq lst '(67 410 10 40 1 50 41 51 7 71 72 11 210))
-       (foreach xh lst ;序号
-        (setq dd (assoc xh ent1)) ;点对
-        (if (/= dd nil)
-     (setq newtxt (append newtxt (list (assoc xh ent1))))
-        ) ;_ 结束if
-       ) ;_ 结束foreach
-       (if (and (setq tca (get 8 ent1)) (/= tca "0"))
-        (setq newtxt (append newtxt (list (cons 8 tca))))
-       ) ;_ End if
-       (setq newtxt (append newtxt (list (cons 73 (get 74 ent1)))))
-       (entmake newtxt)
-       (vla-delete (vlax-ename->vla-object name))
-      ) ;_ 结束progn
-     ) ;_ 结束if
-    ) ;_ 结束while
-   ) ;_ End if
-   (command "explode" bname)
-   (if (setq ssa (ssget "_P" '((0 . "ATTDEF"))))
-    (command ".erase" ssa "")
-   )
-  ) ;_ 结束repeat
- ) ;_ End defun
- (defun get (nnum eent /)
-   (cdr (assoc nnum eent))
- )
- ;呵呵,这一段是最近刚看到的-4才这么写的,不知道是不是太啰嗦了。
- (setq ss (ssget    "_P"
-             (append    (list (cons -4 "<and")
-                       (cons 0 "INSERT")
-                       (cons -4 "<not")
-                       (cons -4 "<or")
-                 ) ;_ End list
-                 lst
-                 (list (cons -4 "or>")
-                       (cons -4 "not>")
-                       (cons -4 "and>")
-                 ) ;_ End list
-             ) ;_ End append
-          ) ;_ End ssget
-     )
|