[编程交流] 是否从图形中删除块？

;; ObjectDBX Example, by Lee McDonnell
;; Credit to Tony Tanzillo, Tim Willey
  
(defun c:blkdel (/ *error* bNme *acad Shell fDir Dir dwLst dbx)
 (vl-load-com)
 ;; Error Handler
 (defun *error* (e)
   (ObjRel (list Shell dbx *acad))
   (if (not (wcmatch (strcase e) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " e " >>")))
   (princ))
 ;; Get Block Name
 (while
   (progn
     (setq bNme (getstring t "\nSpecify Block Name: "))
     (cond ((not (snvalid bNme))
            (princ "\n** Invalid Block Name **"))
           (t (setq bNme (strcase bNme)) nil))))     
 ;; Get Directory
 (setq *acad (vlax-get-acad-object)
       Shell (vla-getInterfaceObject *acad "Shell.Application")
       fDir (vlax-invoke-method Shell 'BrowseForFolder
              (vla-get-HWND *acad) "Select Directory: " 80))
 (and (eq (type Shell) 'VLA-OBJECT)
      (not (vlax-object-released-p Shell))
      (vl-catch-all-apply 'vlax-release-object (list Shell)))
 (if fDir
   (progn
     (setq Dir
       (vlax-get-property
         (vlax-get-property fDir 'Self) 'Path))
     (if (not (eq "\" (substr Dir (strlen Dir))))
       (setq Dir (strcat Dir "\")))
     (princ "\nProcessing...")
     ;; Iterate Drawings
     
     (foreach dwg (setq dwLst
                    (mapcar
                      (function
                        (lambda (x)
                          (strcat Dir x)))
                      (vl-directory-files Dir "*.dwg" 1)))
       (vlax-for doc (vla-get-Documents *acad)
         (and (eq (strcase (vla-get-fullname doc)) (strcase dwg))
              (setq dbx doc)))
       (and (not dbx)
            (setq dbx
              (vlax-create-object
                (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
                  "ObjectDBX.AxDbDocument"
                  (strcat "ObjectDBX.AxDbDocument." (itoa acVer))))))          
       (if (not (vl-catch-all-error-p
                   (vl-catch-all-apply 'vla-open (list dbx dwg))))
         (progn
           (vlax-for lay (vla-get-Layouts dbx)
             (vlax-for Obj (vla-get-Block lay)
               (if (and (eq (vla-get-ObjectName Obj) "AcDbBlockReference")
                        (eq (strcase (vla-get-Name Obj)) BNme))
                 (if (vl-catch-all-error-p
                       (vl-catch-all-apply 'vla-delete (list Obj)))
                   (princ
                     (strcat "\n** Error Deleting Block in: "
                             (vl-filename-base dwg) " **"))))))
           (vla-saveas dbx dwg))
         (princ (strcat "\n** Error Opening File: " (vl-filename-base dwg) " **")))
       (princ (chr 46)))     
             
     ;; Ending Messages
     
     (princ (strcat "\n<< " (rtos (length dwLst) 2 0) " Drawings Processed >>")))
   (princ "*Cancel*"))
 ;; Garbage Collection
 
 (gc) (ObjRel (list Shell dbx *acad))
 (princ))
;; Release Objects ~ Requires List of Variables
           
(defun ObjRel (lst)
 (mapcar
   (function
     (lambda (x)
       (if (and (eq (type x) 'VLA-OBJECT)
                (not (vlax-object-released-p x)))
         (vl-catch-all-apply
           'vlax-release-object (list x))))) lst))