Lisp to delete attributes and lisp to filter a block on a specific layer

[Anonymous]

Hello,

my Tasks are:

1. to change all attributes in the drawing to "empty"

2. to delete an object with the same blockname as others, the only difference between them is the layer so how do i do this ?

[pendean]

1. See attached LISP

2. did not understand this one: can you elaborate.

[dlanorh]

1. If you want to set all block attributes to their "default" value (some attibutes can have default text) then

(command "attsync" "_N" "*")

 or did you mean you want every attribute to display "empty"

2. You'll have to be more specific i.e. Blocks on layer and Block name, or select

[Anonymous]

Thx for your reply,

1. my target is to set attributes where now stands "Type AC 1/9" ,"Type AC 2/9" or something like that, i want them do display nothing like " ". so more or less delete them. And i overlooked that the attributes are in block references sorry for that. Hope thats clear ^^"

2. i draw flats and houses and we have electro distributor´s on layer X  and heating distributor´s on layer Y. The symbols of both of them are Block references with the same name and color so if i would use the AutoCAD command  filter i would do this about the layer, but because there are more other things on layer Y i cant just filter the layer and delete it that way. Hope thats clear now too. 

thx for your patience

[dlanorh]

OK. For each of your tasks:

1. For setting block atributes, do any of the blocks you want to reset have any constant attributes?

2. How do you want to identify the blocks to be deleted? Select one or input block name and layer?

[Anonymous]

1. Yeah, to pick the current plan i have folloing block attributes:

   20x Type AC 1/9 and 12x Type A1/20 and around 150 without attributes

2. we want it automized so we can load it and let it do so i think block name and layer should be the way we are going to use.

[dlanorh]

For 1, try this. I suggest testing it in a copy of the drawing. It currently asks you to select blocks. You can select everything in modelspace as it will filter out anything that is not an attributed block. If you want to automated it, I have commented two lines. If these changes are make you will not be prompted and it will automatically select every attributed block, so beware.

(vl-load-com)
;Clear Block Attributes : This is will clear all variable attributes in ALL selected blocks in modelspace (set textstring to "")
(defun c:CBA (/ *error* ss obj atts)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (prompt "\nSelect Attributed Blocks to Empty : ")             ;; If you want to automate remove this line
  (setq ss (ssget '((0 . "INSERT") (66 . 1) (410 . "Model"))))  ;; If you want to automate (EVERY BLOCK) change this line to (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1) (410 . "Model"))))

  (if ss
    (repeat (setq cnt (sslength ss))
      (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))
            atts (vlax-invoke obj 'getattributes)
      );end_setq
      (mapcar '(lambda (x) (vla-put-textstring x "")) atts)
    );end_repeat
    (princ "\nNothing Selected/Found")
  );end_if
  (princ)
);end_defun

[dlanorh]

As above re testing. This should sort point 2.

(defun c:DBBL (/ *error* c_doc b_lst l_lst bname lyr ss obj)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object)))

  (vlax-map-collection (vla-get-blocks c_doc) '(lambda (x) (setq b_lst (cons (strcase (vlax-get-property x 'name)) b_lst))))
  (vlax-map-collection (vla-get-layers c_doc) '(lambda (x) (setq l_lst (cons (strcase (vlax-get-property x 'name)) l_lst))))
  
  (while (not bname)
    (setq bname (getstring "\nEnter Block Name to Delete : "))
    (cond ( (not (vl-position (strcase bname) b_lst)) (alert (strcat "Block " bname " NOT present in drawing")) (setq bname nil)))
  );end_while
  
  (while (not lyr)
    (setq lyr (getstring "\nEnter Layer Name for Block Deletion : "))
    (cond ( (not (vl-position (strcase lyr) l_lst)) (alert (strcat "Layer " lyr " NOT present in drawing")) (setq lyr nil)))
  );end_while
  
  (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 bname) (cons 8 lyr) '(410 . "Model"))))
  (if ss
    (vla-erase (vla-get-activeselectionset c_doc))
    (princ (strcat "No " bname " Blocks found on Layer " lyr))
  );end_if
  (princ)
);end_defun

[Anonymous]

1. cause i dont get your lisp running i give you a .dwg with the object im talking about. I want the left one´s attributes to be like the right one´s. Maybe i have a basic fault in my description of the problem but im not into this very much so sorry.

[dlanorh]

Sorry, I'm on 2012 so can't open this drawing. Can you save as Autocad 2010 or earlier.

I have attached both lisp as one file below. You need to save this to a directory in an autocad path or your documents, the appload it (type appload on the command line and navigate to where you saved the lisp).

Once loaded type CBA (clear block attributes) or DBBL (delete Block By Layer) on the commandline to run.

[Anonymous]

ofc here ^^

cant appload load out of anywhere? 

[dlanorh]

---

@Anonymous wrote:

ofc here ^^

cant appload load out of anywhere? 

---

Are you running AutoCad LT version?

[Anonymous]

I´m runnig autocad mep 2018 and AutoCAD 2018

[dlanorh]

And if you type appload on the command line of either application nothing happens?

Unfortunately I am now away for a week, and will be without a full version of AutoCad. I can still answer questions, but cannot test code. Perhaps someone else can step in with the final bit.

[Anonymous]

Yep nothing happens it says e.g. resetARRSDBBL succsesfully loaded aaaand thats it, nothing more.

Maybe im making a mistake here: 

(while (not bname)
(setq bname (getstring "\nEnter Block Name to Delete : "))
(cond ( (not (vl-position (strcase bname) b_lst)) (alert (strcat "Block " bname " NOT present in drawing")) (setq bname nil)))
);end_while

(while (not lyr)
(setq lyr (getstring "\nEnter Layer Name for Block Deletion : "))
(cond ( (not (vl-position (strcase lyr) l_lst)) (alert (strcat "Layer " lyr " NOT present in drawing")) (setq lyr nil)))
);end_while

does it have to look like this:

(setq bname (getstring "\nEnter Block Name to Delete : MYBLOCKSNAME"))

(setq lyr (getstring "\nEnter Layer Name for Block Deletion : MYLAYERSNAME"))

or like this:

(setq bname (getstring "MYBLOCKSNAME"))

(setq lyr (getstring "MYLAYERSNAME"))

neither works but thats a question i asked myselfe and maybe there is the problem at some point like this 

I´m really glad that you help me out here ^^"

Another question: 

Can i make it that easy to delete a block per name and layer ?

(command
"_.move" (setq ss (ssget "_X" '((0 . "*TEXT") (1 . "Verteiler,KL,WM,WT,KS,GS,DA")))) "" "200,0" ""
"_.erase" (ssget "_X" '((0 . "*TEXT"))) "_remove" ss ""
"_move" ss "" "-200,0" ""
"_.erase" (ssget "_X" '((0 . "*line"))) "_remove" ss ""
"_.erase" (ssget "_X" '((0 . "circle"))) "_remove" ss ""
"_.erase" (setq SS1 (ssget "X" (list '(0 . "INSERT") (cons 2 "Ventilator")))) "_remove" ss ""
(setq lay_name "MaCE HT_MSR")
"_.erase" (setq SS2 (ssget "X" (list '(0 . "INSERT") (cons 3 "Verteiler") (cons 8 lay_name)))) "_remove" ss ""
"_regenall"
)

I know the green part is working but i also know that the red part isnt. Can you explain me why ?

i gues that the first line of the red is wrong in its Format. Am i guessing right ?

[Anonymous]

Cause my Reply got marked as spam and removed here again:

Yep it just says e.g. resetAttsDBBL successfully loaded and.... yeah thats it nothing happens.

Maybe im making a mistake at this point:

(while (not bname)
(setq bname (getstring "\nEnter Block Name to Delete : "))
(cond ( (not (vl-position (strcase bname) b_lst)) (alert (strcat "Block " bname " NOT present in drawing")) (setq bname nil)))
);end_while

(while (not lyr)
(setq lyr (getstring "\nEnter Layer Name for Block Deletion : "))
(cond ( (not (vl-position (strcase lyr) l_lst)) (alert (strcat "Layer " lyr " NOT present in drawing")) (setq lyr nil)))
);end_while

Does it have to look like this:

(setq bname (getstring "\nEnter Block Name to Delete : MYBLOCKSNAME"))

(setq lyr (getstring "\nEnter Layer Name for Block Deletion : MYLAYERSNAME"))

Or like this:

(setq bname (getstring "MYBLOCKSNAME"))

(setq lyr (getstring "MYLAYERSNAME"))

or am i completely wrong ?

I have another question:

Cant We/I make it that easy to delete a block by its name and layer?
(command
"_.move" (setq ss (ssget "_X" '((0 . "*TEXT") (1 . "Verteiler,KL,WM,WT,KS,GS,DA")))) "" "200,0" ""
"_.erase" (ssget "_X" '((0 . "*TEXT"))) "_remove" ss ""
"_move" ss "" "-200,0" ""
"_.erase" (ssget "_X" '((0 . "*line"))) "_remove" ss ""
"_.erase" (ssget "_X" '((0 . "circle"))) "_remove" ss ""
"_.erase" (setq SS1 (ssget "X" (list '(0 . "INSERT") (cons 2 "Ventilator")))) "_remove" ss ""
(setq lay_name "MaCE HT_MSR")
"_.erase" (setq SS2 (ssget "X" (list '(0 . "INSERT") (cons 3 "Verteiler") (cons 8 lay_name)))) "_remove" ss ""
"_regenall"
)

I gues the first line of my red part is the mistake but idk.

I´m glad you´r helping me out here ^^"

[Anonymous]

(command
"_.move" (setq ss (ssget "_X" '((0 . "*TEXT") (1 . "Verteiler,KL,WM,WT,KS,GS,DA")))) "" "200,0" ""
"_.erase" (ssget "_X" '((0 . "*TEXT"))) "_remove" ss ""
"_.move" ss "" "-200,0" ""
"_.erase" (ssget "_X" '((0 . "*line"))) "_remove" ss ""
"_.erase" (ssget "_X" '((0 . "circle"))) "_remove" ss ""
"_.erase" (setq SS1 (ssget "X" (list '(0 . "INSERT") (cons 2 "Ventilator")))) "_remove" ss ""
"_.erase" (setq SS2 (ssget "X" (list '(0 . "INSERT") (cons 2 "Verteiler") (cons 8 "MaCE HT_MSR")))) "_remove" ss ""
"_regenall"
)

Like this it works perfectly fine the only thing i have to do now are these little anoying attributes.

[ssmith774556EVN]

how do I initiate this lsp?

[ssmith774556EVN]

How do i get it to run?

[Kent1Cooper]

---

@ssmith774556EVN wrote:

how do I initiate this lsp?

---

A good place to find out is at Lee Mac's instructions >here<.