如何删除空的图块！

tm20038175

有一些没有图元的图块，想删除掉，但是不知道如何删除…………

panliang9

同问，很多时候发现图纸上有很多图块实际一点内容都不存在了，怎么把它删去，特别是镶套在别的块里面的。

panliang9

自已找了一个：

找到一段代码：

; Delete Null Objects
;; DelNul.lsp   
;; Deletes nul lines of Text, Mtext & Blocks.
;; Modified by JL Thomas 12/02/97

(Defun C:DelNul ( / TXT BLK NB NAMES)
  (if(setq TXT (ssget "X" '((-4 . "<and")(-4 . "<or")
                           (0 . "MTEXT")(0 . "TEXT")
                           (-4 . "or>")(-4 . "<or")
                           (1 . "")(1 . " ")(1 . "  ")(1 . "   ")
                           (1 . "{}")(1 . "{ }")(1 . "{  }")(1 . "{   }")
                           (1 . "{}\P")(1 . "{ }\P")(1 . "{  }\P")(1 . "{   }\P")
                           (-4 . "or>")(-4 . "and>"))))
  (progn
    (command"_erase"TXT"")
    (princ(strcat"\n  "(itoa(sslength TXT))" nul text strings deleted. "))
   )
  (princ"\n  No nul text strings found. "))

  (setq BLK(tblnext"BLOCK"T)NAMES nil)
  (while BLK
    (if(=(cdr(assoc 0(entget(cdr(assoc -2 BLK)))))"ENDBLK")
    (progn
      (if(setq NB(ssget "X" (list(assoc 2 BLK))))
      (command"_erase"NB"")
       )
    (setq NAMES(cons(cdr(assoc 2 BLK))NAMES))
     )
   )
  (setq BLK(tblnext"BLOCK"))
  )
  (if NAMES
    (progn(textscr)
    (princ"\n  Nul blocks found and need purging: ")
    (foreach X NAMES(princ"\n    ")(princ X))
   )
  (princ"\n  No nul blocks found. ")
  )
(princ)
)
(c:DelNul)

panliang9

又找到一段，还没有测试，不知道行不行，
在这个网站：
http://www.thecadforums.com/auto ... d-empty-blocks.html

;; This routine will remove all nested blocks that are empty
;; Make sure all layers are unlocked before running it

(defun c:nested ( / blk_list ename elist elist1 rewind this_one this_many)
(command "_.undo" "mark")
(setq error_old *error* *error* ermessage)
(setvar "cmdecho" 0)
(setq Rewind T
blk_list nil
)
(while (setq Elist1 (tblnext "BLOCK" Rewind))
(setq Rewind nil
Ename (cdr (assoc -2 Elist1))
)
(while Ename
(setq EList (entget Ename))
(if (= "INSERT" (cdr (assoc 0 Elist)))
(if (= "ENDBLK" (cdr (assoc 0 (entget (cdr (assoc -2 (tblsearch "block" (cdr (assoc 2 elist)))))))))
(setq blk_list (append blk_list (list Ename)))
)
)
(setq Ename (entnext Ename))
)
)
(setq this_many (rtos (length blk_list) 2 0))
(while blk_list
(setq this_one (car blk_list))
(axeleteObjectFromBlock this_one)
(setq blk_list (cdr blk_list))
)
(command "purge" "b" "*" "n")
(if (= this_many "1")
(princ (strcat " " this_many " empty nested block definition removed."))
(princ (strcat " " this_many " empty nested block definitions removed."))
)
(setq *error* error_old)
(setvar "cmdecho" 1)
(princ)
)

tm20038175

panliang9 发表于 2012-5-21 22:10
又找到一段，还没有测试，不知道行不行，
在这个网站：
http://www.thecadforums.com/autocad-customizat ...

真是好心人呀，太感谢了！………

caoyin

;;提供一个效率更高，删除更彻底的方法
;;对于被写入词典的块无法删除
;;删除空的块容器---by caoyin 2012.5.22
(defun C:DelNulBlk (/ LST)
  (vlax-for BLK
    (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
    (if (and (zerop (vla-get-Count BLK))
             (= (vla-get-IsLayout BLK) :VLAX-FALSE)
        )
      (setq LST (cons (vla-get-Name BLK) LST))
    )
  )
  (vlax-for BLK BLKS
    (vlax-for OBJ BLK
      (if (and (= (vla-get-objectName OBJ) "AcDbBlockReference")
               (member (vla-get-Name OBJ) LST)
          )
        (vl-catch-all-apply 'vla-delete (list OBJ))
      )
    )
  )
)

smartstar

好贴，谢谢。

tm20038175

caoyin 发表于 2012-5-22 07:47
;;提供一个效率更高，删除更彻底的方法
;;对于被写入词典的块无法删除
;;删除空的块容器---by caoyin 201 ...

好的，谢谢哈~~~

c735023723

呵呵，谢谢