Topic: Remove or modify all block descriptions

[cadmoogle]

s it possible to remove all existing block definitions VIA lisp?

Name: 1WM_METER
Description: 1" Water main meter

I need to modify or remove the old descriptions completely. If I could remove I would like to do this to a large number if possible.

I'm not sure if AutoCAD has a built in feature for this, does anyone else know?

**I found a way to remove the descriptions from the tool palette, but not in AutoCAD without redefining the block.

Thanks in advance,
Daniel

For the members who use Cadalyst, my post link for that site is http://forums.cadalyst.com/showthread.php?p=23252#post23252

[dustinthiesse]

Not sure exactly what you're wanting here.
These two lines will delete all blocks named 1WM_METER from your drawing and purge the definition.

Code: [Select]

(command "_erase" (ssget "X" '((0 . "INSERT")(2 . "1WM_METER"))) "")
(command "_-purge" "blocks" "1WM_METER" "n")


[cadmoogle]

I don't wish to delete the block it self just the description. Sorry I just noticed I placed definition in the subject 

I was able to piece the following code together from what others have posted online. It will work on just one block (16X16WM_CROSS), how can I modify it to work on all blocks in the drawing?

Thank you,
Daniel

Code: [Select]

(defun c:bwipe ()
(setq a (entget (tblobjname "block" "16X16WM_CROSS")))
(setq a (append a (list (cons 4 "DESCRIPTION HERE"))))
(entmake a)
(setq b (cdr (assoc -1 a)))
(while (setq b (entnext b))
(entmake (entget b))
)
(setq e (entmake (list (cons 0 "endblk"))))
)


[dustinthiesse]

Ahhh...I misunderstood.  So you want to get rid of all block descriptions in the drawing?
Something like this perhaps?

Code: [Select]

(defun c:bwipe()
  (defun wipeone (bname)
    (setq a (entget (tblobjname "block" bname)))
    (setq a (append a (list (cons 4 "DESCRIPTION HERE"))))
    (entmake a)
    (setq b (cdr (assoc -1 a)))
    (while (setq b (entnext b))
      (entmake (entget b))
    )
    (setq e (entmake (list (cons 0 "endblk"))))
  );defun wipeone

  (setq bname(cdr(assoc 2(tblnext "BLOCK" 1))))
  (wipeone bname)
  (while(/= (setq bname(cdr(assoc 2(tblnext "BLOCK")))) nil)
    (wipeone bname)
  );while
  (princ)
);defun bwipe
(princ "BWIPE")


[cadmoogle]

Thanks for the quick reply when I run the command I get the following error.

Command:
Command: (LOAD "C:/Documents and Settings/dgj520/Desktop/TES2T.lsp")
BWIPE"BWIPE"

Command: bwipe
; error: bad argument type: stringp ((0 . "BLOCK") (2 . "12WM_22.5BEND") (70 .
0) (4 . "12\" 22-1/2D BEND FOR WATER MAIN") (10 0.0 0.0 0.0) (-2 . <Entity
name: 7ef23478>))

Command:

[dustinthiesse]

That's what I get for typing faster than I'm thinking.
I've edited the code above to set the block name correctly.
One thing I think I need to add is a filter for xrefs though.  It might crash on an xref.
NOTE:  If you're trying to get rid of the descriptions then you'll want to get rid of the "DESCRIPTION HERE" part.
Change it to "" instead.

[dustinthiesse]

OK Here's the whole code again.
Now it filters out xrefs and xref blocks so it won't crash in those cases.

Code: [Select]

(defun c:bwipe()
  (defun wipeone (bname)
    (setq a (entget (tblobjname "block" bname)))
    (setq a (append a (list (cons 4 ""))))
    (entmake a)
    (setq b (cdr (assoc -1 a)))
    (while (setq b (entnext b))
      (entmake (entget b))
    )
    (setq e (entmake (list (cons 0 "endblk"))))
  );defun wipeone

  (setq blk(tblnext "BLOCK" 1))
  (if(and
       (not(assoc 1 blk)) ;not xref
       (not(vl-string-position (ascii "|") (cdr(assoc 2 blk)))) ;not part of xref
     )
    (progn
      (setq bname(cdr(assoc 2 blk)))
      (wipeone bname)
    )
  );if
  (while(/= (setq blk(tblnext "BLOCK")) nil)
    (if(and
(not(assoc 1 blk))
(not(vl-string-position (ascii "|") (cdr(assoc 2 blk))))
       )
      (progn
        (setq bname(cdr(assoc 2 blk)))
        (wipeone bname)
      )
    );if
  );while
  (princ)
);defun bwipe
(princ "BWIPE")


[cadmoogle]

Here is the version 1.2

I changed the name and added some lines of text. Thank you for your help.

Code: [Select]

;;Block description wipe v1.2
;;Resets all block descriptions to blank
;;Thanks to dustinthiesse from TheSwamp
(defun c:bdwipe()
  (defun wipeone (bname)
    (setq a (entget (tblobjname "block" bname)))
    (setq a (append a (list (cons 4 " ")))); Modify quotes if needed
    (entmake a)
    (setq b (cdr (assoc -1 a)))
    (while (setq b (entnext b))
    (entmake (entget b))
    )
    (setq e (entmake (list (cons 0 "endblk"))))
  );defun wipeone

  (setq blk(tblnext "BLOCK" 1))
  (if(and
       (not(assoc 1 blk));not xref
       (not(vl-string-position (ascii "|") (cdr(assoc 2 blk))));not part of xref
     )
    (progn
      (setq bname(cdr(assoc 2 blk)))
      (wipeone bname)
    )
  );if
  (while(/= (setq blk(tblnext "BLOCK")) nil)
    (if(and
(not(assoc 1 blk))
(not(vl-string-position (ascii "|") (cdr(assoc 2 blk))))
       )
      (progn
        (setq bname(cdr(assoc 2 blk)))
        (wipeone bname)
      )
    );if
  );while
  (princ)
);defun bwipe
(princ "Type BDWIPE to run command")
(princ)


[ronjonp]

You also might want to localize your variables:

(defun c:bdwipe (/ blk bname e wipeone)
  (defun wipeone (bname / a b e)

[dustinthiesse]

You also might want to localize your variables:

(defun c:bdwipe (/ blk bname e wipeone)
  (defun wipeone (bname / a b e)

True.
Question for ya ronjon.  If you localize the function "wipeone" can it still be called external to the program or would it then be limited to only being called within C:BDWIPE?

I ask because a lot of the times I will set up functions like I did here where the main function will run with some default values (for use mainly by general users who don't care how the program actually works), but I like to have the ability to still be able to call the sub-functions independently by other programs and provide parameters other than the defaults in that manner.  Maybe I'm making my setup more complex than it needs to be, but I think it gives me more flexibility.

[ronjonp]

You also might want to localize your variables:

(defun c:bdwipe (/ blk bname e wipeone)
  (defun wipeone (bname / a b e)

True.
Question for ya ronjon.  If you localize the function "wipeone" can it still be called external to the program or would it then be limited to only being called within C:BDWIPE?
.....

It will only be available for C:BDWIPE. I would think a better plan of action would be to load all your functions with startup. It kinda defeats the purpose of reusing the code if it is located in program "A" and needed in program "B" but program "A" has not run yet? Or am I missing something?

[dustinthiesse]

You also might want to localize your variables:

(defun c:bdwipe (/ blk bname e wipeone)
  (defun wipeone (bname / a b e)

True.
Question for ya ronjon.  If you localize the function "wipeone" can it still be called external to the program or would it then be limited to only being called within C:BDWIPE?
.....

It will only be available for C:BDWIPE. I would think a better plan of action would be to load all your functions with startup. It kinda defeats the purpose of reusing the code if it is located in program "A" and needed in program "B" but program "A" has not run yet? Or am I missing something?

Actually, I just realized I'm talking about a different scenario.  I've got lisp files that contain multiple functions but they are not nested within each other.   :doa:

[CAB]

Another routine to consider.

Code: [Select]

;;  CAB 01.06.09
(defun RemoveBlockDescription (/ data)
  (vl-load-com)
  (while (setq data (tblnext "block" (null data)))
    (if (and (zerop (logand 21 (cdr (assoc 70 data)))) ; ignore xref, xref dependent, anonymous
             (not (equal '(4 . "") (assoc 4 data)))
        )
      (vl-catch-all-apply
        '(lambda (/ elst ent)
           (setq elst (entget (tblobjname "block" (cdr (assoc 2 data)))))
           (entmake (subst '(4 . " ") (assoc 4 elst) elst))
           (setq ent (cdr (assoc -1 elst)))
           (while (setq ent (entnext ent))
             (entmake (entget ent))
           )
           (entmake (list (cons 0 "endblk")))
         )
      )
    )
  )
)

[dustinthiesse]

Nice tricks CAB.  I always enjoy learning from your code.  I'll have to remember the (setq data(tblnext "block" (null data))) and logand tricks for sure!

I've got a question.  If I select an XREF entity by using (setq data(entget(car(entsel)))), the DXF code 70 is 0; but if I cycle through the block table using (setq data(tblnext "block" (null data))), the DXF code 70 for that same XREF is 44.  What gives?

[T.Willey]

(setq data(entget(car(entsel))))

This will get the dxf code for the insert, not the block definition, where as

(setq data(tblnext "block" (null data)))

gets the dxf code for the block definition.

With the first code, data equals

(-1 . <Entity name: 75b0ae00>)
(0 . "INSERT")
(330 . <Entity name: 7becac10>)
(5 . "4F50")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "XREF")
(100 . "AcDbBlockReference")
(2 . "NORT-009-A-1FL")
(10 0.0 0.0 0.0)
(41 . 1.0)
(42 . 1.0)
(43 . 1.0)
(50 . 0.0)
(70 . 0)
(71 . 0)
(44 . 0.0)
(45 . 0.0)
(210 0.0 0.0 1.0)

Notice the dxf code 0.  Now to get the block definition of selected blocks just use

Code: [Select]

(setq data (entget (tblobjname "block" (cdr (assoc 2 data)))))
Which will return

(-1 . <Entity name: 75b0ac30>)
(0 . "BLOCK")
(330 . <Entity name: 75b0ac28>)
(5 . "4F16")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbBlockBegin")
(70 . 44)
(10 0.0 0.0 0.0)
(-2 . <Entity name: 740dddf8>)
(2 . "NORT-009-A-1FL")
(1 . "NORT-009-A-1FL.DWG")

Now notice the dxf code 0, and the correct way to test dxf code 70 for xref'ness.

Hope that clears some things up.

[dustinthiesse]

Makes perfect sense.  Thanks.
I was getting my info here http://www.jefferypsanders.com/autolispexp_enti.html#Block.
Great site, but the part there about the group code 70 is a bit misleading according to what you're telling me.

[CAB]

You may want to play with this:

Code: [Select]

(defun c:test ()
  (while
    (cond
      ((null (setq data (entsel)))
       (princ "\nMissed, Try again.")
      )
      ((and (equal '(0 . "INSERT") (assoc 0 (setq elst (entget (car data)))))
            (not (zerop (logand 20 (cdr (assoc 70 (entget
                  (tblobjname "block" (cdr (assoc 2 elst))))))))))
       (princ "\nxRef not allowed, Try again.")
      )
      (t
       (prompt "\nValad selection.")
      )
    )
  )
  (princ)
)

[CAB]

Yes for the INSERT see this gropu 70

Code: [Select]

Insert group codes

Group code        Description
100      Subclass marker (AcDbBlockReference)
66       Variable attributes-follow flag (optional; default = 0); if the value of attributes-follow flag is 1, a series of attribute entities is expected to follow the insert, terminated by a seqend entity
2        Block name
10       Insertion point (in OCS)
DXF: X value; APP: 3D point
20, 30   DXF: Y and Z values of insertion point (in OCS)
41       X scale factor (optional; default = 1)
42       Y scale factor (optional; default = 1)
43       Z scale factor (optional; default = 1)
50       Rotation angle (optional; default = 0)
70       Column count (optional; default = 1)
71       Row count (optional; default = 1)
44       Column spacing (optional; default = 0)
45       Row spacing (optional; default = 0)
210      Extrusion direction (optional; default = 0, 0, 1)
DXF: X value; APP: 3D vector
220, 230 DXF: Y and Z values of extrusion direction (optional)

[dustinthiesse]

Thanks CAB.  That code looked so simple at first, but it's really quite sophisticated.

One thing though, it allows for the selection of an entity that isn't a block.
I've split your 'and' statement into two separate conditions to check "insert" first, then check xref.

Code: [Select]

(defun c:test ()
  (while
    (cond
      ((null (setq data (entsel)))
       (princ "\nMissed, Try again.")
      )
      ((not (equal '(0 . "INSERT") (assoc 0 (setq elst (entget (car data))))))
       (princ "\nMust select a block, Try again.")
      )
      ((not (zerop (logand 20 (cdr (assoc 70 (entget
              (tblobjname "block" (cdr (assoc 2 elst)))))))))
       (princ "\nxRef not allowed, Try again.")
      )
      (t
       (prompt "\nValid selection.")
      )
    )
  )
  (princ)
)


[CAB]

Thanks.
It was just a sample to play with.
Lots of possibilities.

[dustinthiesse]

((and (equal '(0 . "INSERT") (assoc 0 (setq elst (entget (car data)))))
          (not (zerop (logand 20 (cdr (assoc 70 (entget
                  (tblobjname "block" (cdr (assoc 2 elst))))))))))
)

I spent a while trying to figure out why that 'and' statement didn't fail.
I finally realized that lisp must process each argument to the 'and' statement one by one and if it comes across one that is false then it immediately returns nil.  I just couldn't stop thinking 'how does that "(tblobjname..." not fail in the case where the selected object isn't a block!?
The 'equal' statement returns a false first and it never gets that far!!!
I get too excited about this stuff, I know.

[CAB]

I get too excited about this stuff, I know.

You're in good company here.

Take a look at this post.
http://www.theswamp.org/index.php?topic=13046.msg158557#msg158557