Author Topic: How to: vla-delete  (Read 10569 times)

0 Members and 1 Guest are viewing this topic.

GDF

  • Water Moccasin
  • Posts: 2081
How to: vla-delete
« on: January 13, 2011, 03:54:30 PM »
Ok, how do I modify the routine below from exploding the block list to deleteing them?

Code: [Select]
(defun ARCH:Explode (/ i ss ent obj)
  (if (setq i -1 ss (ssget "_X" '((0 . "INSERT") (2 . "DR-*,WD-*"))))
    (while (setq ent (ssname ss (setq i (1+ i))))
      (and (not (vl-catch-all-error-p
                  (vl-catch-all-apply 'vla-explode
                    (list (setq obj (vlax-ename->vla-object ent))))))
           (vla-delete obj)))))

Something like this one, but for  (ssget "_X" '((0 . "INSERT") (2 . "DR-*,WD-*"))))

Code: [Select]
(defun ARCH:DeleteBlock (name / Ent EntData )   
    (if (setq Ent (tblobjname "block" name))
        (progn
            (setq EntData (entget Ent))
            (setq Ent (cdr (assoc 330 EntData)))
            (setq EntData (entget Ent))
            (foreach i (member '(102 . "{BLKREFS") EntData)
                (if
                    (and
                        (equal (type (cdr i)) 'ENAME)
                        (not (vlax-erased-p (cdr i)))
                    )
                    (vla-Delete (vlax-ename->vla-object (cdr i)))
                )
            )
        )
    )
)
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ronjonp

  • Needs a day job
  • Posts: 7526
Re: How to: vla-delete
« Reply #1 on: January 13, 2011, 04:00:20 PM »
You could use entdel just as easily to remove these objects:

Code: [Select]
  (if (setq i  -1
    ss (ssget "_X" '((0 . "INSERT") (2 . "DR-*,WD-*")))
      )
    (while (setq ent (ssname ss (setq i (1+ i)))) (entdel ent))
  )

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

GDF

  • Water Moccasin
  • Posts: 2081
Re: How to: vla-delete
« Reply #2 on: January 13, 2011, 04:07:14 PM »
Thanks, why do I have to make it complicated?
LOL
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ronjonp

  • Needs a day job
  • Posts: 7526
Re: How to: vla-delete
« Reply #3 on: January 13, 2011, 04:13:27 PM »
Thanks, why do I have to make it complicated?
LOL

I do it all the time  :-D

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

T.Willey

  • Needs a day job
  • Posts: 5251
Re: How to: vla-delete
« Reply #4 on: January 13, 2011, 04:14:00 PM »
I forget, but does ' entdel ' work in spaces besides the current one?  I remember trying it before, but it didn't do what I wanted, so I had to use the ActiveX way.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: How to: vla-delete
« Reply #5 on: January 13, 2011, 04:23:26 PM »
I forget, but does ' entdel ' work in spaces besides the current one?  I remember trying it before, but it didn't do what I wanted, so I had to use the ActiveX way.

Looks like it works with modelspace and last active layout.

Better use vla-delete Gary (if you're concerned about deleting items from all paperspace tabs)

Code: [Select]
  (if (setq i  -1
    ss (ssget "_X")
      )
    (while (setq ent (ssname ss (setq i (1+ i))))
      (vl-catch-all-apply 'vla-delete (list (vlax-ename->vla-object ent)))
    )
  )

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

GDF

  • Water Moccasin
  • Posts: 2081
Re: How to: vla-delete
« Reply #6 on: January 13, 2011, 04:39:43 PM »
Thanks Ron and Tim

Here is the routine where it is used to make CAD file backgrounds for a consultant.

Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:LayerTableSearch (layername)
  (if (tblsearch "LAYER" layername)
    (ARCH:DeleteLayer layername)
  )
)
(defun ARCH:BlockTableSearch (blockname)
  (if (tblsearch "BLOCK" blockname)
    (ARCH:DeleteBlockName blockname)
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:DeleteLayer  (layer_name / ent acapp acsp adoc allrs layer_name TotalNumber
                          CurrNumber)
  (vl-load-com)   
  (setq acapp (vlax-get-acad-object)
        adoc  (vla-get-activedocument acapp)
        acsp  (vla-get-block (vla-get-activelayout adoc))
        allrs (vla-get-layers adoc))
  (setq TotalNumber
         (sslength (ssget "_X" (list (cons 8 layer_name))))
        CurrNumber 1) 
  (or (eq (vla-get-freeze (vla-item allrs layer_name)) :vlax-true)
      (vla-put-freeze (vla-item allrs layer_name) :vlax-false))
  (or (eq (vla-get-lock (vla-item allrs layer_name)) :vlax-true)
      (vla-put-lock (vla-item allrs layer_name) :vlax-false))
  (or (eq (vla-get-layeron (vla-item allrs layer_name)) :vlax-false)
      (vla-put-layeron (vla-item allrs layer_name) :vlax-true))
  (vlax-for
         lt  (vla-get-layouts adoc)
    (vlax-for
           ob  (vla-get-block lt)
      (if (eq (vla-get-layer ob) layer_name)
        (progn (vla-delete ob)
               (vlax-release-object ob)))))
  ;;(command "purge" "LA" layer_name "no")
  (vla-purgeall (vla-get-activedocument (vlax-get-acad-object))) 
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:DeleteBlockName (name / Ent EntData )   
    (if (setq Ent (tblobjname "block" name))
        (progn
            (setq EntData (entget Ent))
            (setq Ent (cdr (assoc 330 EntData)))
            (setq EntData (entget Ent))
            (foreach i (member '(102 . "{BLKREFS") EntData)
                (if
                    (and
                        (equal (type (cdr i)) 'ENAME)
                        (not (vlax-erased-p (cdr i)))
                    )
                    (vla-Delete (vlax-ename->vla-object (cdr i)))
                )
            )
        )
    )
)
(defun ARCH:DeleteBLOCKS-original (/ i ss ent) 
  (if (setq i -1 ss (ssget "_X" '((0 . "INSERT") (2 . "ADA*,FND-*,FLR-*,RF-*,*NOTES,*GRID*,*DATE,*ENTRY"))))
    (while (setq ent (ssname ss (setq i (1+ i)))) (entdel ent))
  )
)
(defun ARCH:DeleteBLOCKS (/ i ss ent)
  (if (setq i -1 ss (ssget "_X" '((0 . "INSERT") (2 . "ADA*,FND-*,FLR-*,RF-*,*NOTES,*GRID*,*DATE,*ENTRY"))))
    (while (setq ent (ssname ss (setq i (1+ i))))
      (vl-catch-all-apply 'vla-delete (list (vlax-ename->vla-object ent)))
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:ThwOnUnlock  (/ lyr lyrList) 
  (setq lyr (tblnext "layer" 'T)) 
  (while lyr
    (if (not (zerop (logand (cdr (assoc 70 lyr)) 1)))
      (setq lyrList (cons (cdr (assoc 2 lyr)) lyrList)))           
    (setq lyr (tblnext "layer"))) 
      (progn (setvar "cmdecho" 0)
             (command ".layer" "on" "*" "")             
             (command ".layer" "thaw" "*" "")
             (command ".layer" "unlock" "*" "")             
             ) 
  ;;(princ "\n* All Layers have been THAWED, TURNED ON and UNLOCKED *")
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:FrzOff  (/ lyr lyrList) 
  (setq lyr (tblnext "layer" 'T)) 
  (while lyr
    (if (not (zerop (logand (cdr (assoc 70 lyr)) 1)))
      (setq lyrList (cons (cdr (assoc 2 lyr)) lyrList)))           
    (setq lyr (tblnext "layer"))) 
      (progn (setvar "cmdecho" 0)
             (command ".layer" "off" "*" "")             
             (command ".layer" "freeze" "*" "")                     
             )   
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:ExplodeBLDG (/ i ss ent obj)
  (if (setq i -1 ss (ssget "_X" '((0 . "INSERT") (2 . "BL*"))))
    (while (setq ent (ssname ss (setq i (1+ i))))
      (and (not (vl-catch-all-error-p
                  (vl-catch-all-apply 'vla-explode
                    (list (setq obj (vlax-ename->vla-object ent))))))
           (vla-delete obj)))))
(defun ARCH:ExplodeUNIT (/ i ss ent obj)
  (if (setq i -1 ss (ssget "_X" '((0 . "INSERT") (2 . "UT*"))))
    (while (setq ent (ssname ss (setq i (1+ i))))
      (and (not (vl-catch-all-error-p
                  (vl-catch-all-apply 'vla-explode
                    (list (setq obj (vlax-ename->vla-object ent))))))
           (vla-delete obj)))))
(defun ARCH:ExplodewASHDRY (/ i ss ent obj)
  (if (setq i -1 ss (ssget "_X" '((0 . "INSERT") (2 . "PN-WASHDRY"))))
    (while (setq ent (ssname ss (setq i (1+ i))))
      (and (not (vl-catch-all-error-p
                  (vl-catch-all-apply 'vla-explode
                    (list (setq obj (vlax-ename->vla-object ent))))))
           (vla-delete obj)))))
(defun ARCH:ExplodeBLOCKS (/ i ss ent obj)
  (if (setq i -1 ss (ssget "_X" '((0 . "INSERT") (2 . "Elev*,A$*,PN-Mail2,PN-EP,PN-WCONN,PN-DCONN,MC-PN,TB-PN"))))
    (while (setq ent (ssname ss (setq i (1+ i))))
      (and (not (vl-catch-all-error-p
                  (vl-catch-all-apply 'vla-explode
                    (list (setq obj (vlax-ename->vla-object ent))))))
           (vla-delete obj)))))
(defun ARCH:ExplodeDRWDW (/ i ss ent obj)
  (if (setq i -1 ss (ssget "_X" '((0 . "INSERT") (2 . "DR-*,WD-*"))))
    (while (setq ent (ssname ss (setq i (1+ i))))
      (and (not (vl-catch-all-error-p
                  (vl-catch-all-apply 'vla-explode
                    (list (setq obj (vlax-ename->vla-object ent))))))
           (vla-delete obj)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun CadBackgrounds-it  ()     
  ;;(acet-ui-status  (strcat "Please WAIT while the program is working!\nThis may take a while.") " Arch Program© : CAD")   
  (prompt "\n*  Please WAIT while the program is working! *")   
  (acet-ui-status  (strcat "CONGRATULATIONS...\nCAD background successfully completed.") " Please WAIT while the program is working!")
  (C:00)
  (ARCH:ThwOnUnlock)   
  (setq bt (getvar "bindtype")) 
  (setvar "bindtype" 1) 
  (command "-xref" "b" "*")   
  (ARCH:ExplodeBLDG)
  ;;(ARCH:ExplodeDRWDW)
  (ARCH:ExplodeUNIT)
  (command "insert" (strcat "A$C042E4D5F=" ARCH#CUSF "SYMS/" "A$C042E4D5F"))
  (command)
  (ARCH:ExplodeWASHDRY)
  (ARCH:ExplodeBLOCKS)
;|
  (ARCH:BlockTableSearch "EF-FAN1")
  (ARCH:BlockTableSearch "FloorPlanNotes")
  (ARCH:BlockTableSearch "FoundatioNotes")
  (ARCH:BlockTableSearch "Ada-4830")
  (ARCH:BlockTableSearch "Ada-6060")
  (ARCH:BlockTableSearch "Ada-hc")
  (ARCH:BlockTableSearch "SYMENTRY") 
  (ARCH:BlockTableSearch "SHT_GRID")
  (ARCH:BlockTableSearch "ISSUEDATE") 
  (ARCH:BlockTableSearch "FLR-SYMS2")
  (ARCH:BlockTableSearch "FND-SYMS3")
  (ARCH:BlockTableSearch "RF-SYMS2")
  (ARCH:BlockTableSearch "AMPCORV")
  (ARCH:BlockTableSearch "PN-ACESDRS")
|;
  (ARCH:DeleteBLOCKS)
 
  (ARCH:LayerTableSearch "A-DIMS")   
  (ARCH:LayerTableSearch "A-PLFL-HIDE")
  (ARCH:LayerTableSearch "A-PLFL-PATT")
  (ARCH:LayerTableSearch "A-PLFL-NOTE")
  (ARCH:LayerTableSearch "A-NOTE")
  (ARCH:LayerTableSearch "A-NOTE-LDR")
  (ARCH:LayerTableSearch "A-PATT") 
  (ARCH:LayerTableSearch "A-REVS-CLOD")
  (ARCH:LayerTableSearch "A-REVS-SYMB")
  (ARCH:LayerTableSearch "A-SHTT-DATA")
  (ARCH:LayerTableSearch "A-SYMB")
  (ARCH:LayerTableSearch "A-SYMB-DOOR")
  (ARCH:LayerTableSearch "A-SYMB-LBRK")
  (ARCH:LayerTableSearch "A-SYMB-MARK")
  (ARCH:LayerTableSearch "A-SYMB-MTCH")
  (ARCH:LayerTableSearch "A-SYMB-PART")
  (ARCH:LayerTableSearch "A-SYMB-ROOM")
  (ARCH:LayerTableSearch "A-SYMB-WDW")
  (ARCH:LayerTableSearch "LS-2HF")
  (ARCH:LayerTableSearch "A-AREA") 
  (ARCH:LayerTableSearch "A-AREA-GROS")
  (ARCH:LayerTableSearch "A-AREA-NET")
  (ARCH:LayerTableSearch "A-ALT-WIND-D")
  (ARCH:LayerTableSearch "A-ALT-WIND-3")
  (ARCH:LayerTableSearch "A-FURN")
  (ARCH:LayerTableSearch "A-HC")
  (ARCH:LayerTableSearch "A-PATT-POCH")
  (ARCH:LayerTableSearch "A-SYMB-IDEN")
  (ARCH:LayerTableSearch "A-WALL-PATT")
  (ARCH:LayerTableSearch "E-POWR-NOTE")
  (ARCH:LayerTableSearch "S-COLS-GRID")
  (ARCH:LayerTableSearch "A-EXIT-TEXT")
  (ARCH:LayerTableSearch "E-POWR-NOTE")
  (ARCH:LayerTableSearch "X-REDL")
  (ARCH:LayerTableSearch "JUNK")
  (ARCH:LayerTableSearch "DEFPOINTS") 

  (ARCH:FrzOff "A-DOOR-CODE")
  (ARCH:FrzOff "A-CLNG-HEAD")

  (vla-purgeall (vla-get-activedocument (vlax-get-acad-object)))
  ;;(C:XS)
  (setvar "bindtype" bt) 
  (princ "\n*  CAD background successfully completed...  *")
  ;;(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun CadBackgroundsit  (/ result)
  (setq Result (ARCH:QUESTION-5
                 "Create CAD Backgrounds"
                 "     Warning this will Bind, Explode and Purge ALL Xrefs.\n"
                 "     Make sure this is NOT the Original Drawing!!!\n\n"
                 "     [ 1 ]\t  to continue on...\n" "     [ 2 ]\t  to cancel." ""))
  (cond ((= 0 Result) (CadBackgrounds-it))
        ((= 1 Result)
         (princ "\n*** ///////// Program  CANCELLED ///////// ***")))
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64