TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: V-Man on January 26, 2012, 04:24:03 PM
-
I need to search for a particular block name and once found check to see if the attribute is null. If so, I want to delete the block(s) for all instances in the drawing. If the attribute is "filled" in with a value then leave those blocks alone. Any simple code out there to accomplish?
Thnx.
-
Quick and untested...
(defun _EraseBlockReferencesWithNullAttributeValue (blockname attributetag / ss i e)
(if (setq ss (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 blockname))))
(repeat (setq i (sslength ss))
(if
(vl-some
(function (lambda (a)
(and (eq (strcase (vla-get-tagstring a)) (strcase attributetag))
(eq (vla-get-textstring a) "")
)
)
)
(vlax-invoke (vlax-ename->vla-object (setq e (ssname ss (setq i (1- i))))) 'GetAttributes)
)
(entdel e)
)
)
)
(princ)
)
-
for all instances in the drawing
Does that include inserts where one insert has a null attribute but another of the same name does not?
-
[quote author=alanjt link=topic=40781.msg460478#msg460478 date=1327613537]
Quick and untested...
...[/quote]
Nice 8-)
-
Does that include inserts where one insert has a null attribute but another of the same name does not?
Yes
-
Pure AutoLisp (no VisualLisp calls):
(defun _EraseBlockReferencesWithNullAttributeValue_A (blockname attributetag / ss n en an ad ToErase)
(if (setq ss (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 blockname))))
(progn
(setq n (sslength ss))
(while (> (setq n (1- n)) -1)
(setq en (ssname ss n)
ToErase nil
ad (entget (setq an (entnext en)))
)
(while (and (not ToErase) (eq (cdr (assoc 0 ad) "ATTRIB")))
(setq ToErase (and (eq (cdr (assoc 2 ad)) attributetag) (eq (cdr (assoc 1 ad)) ""))
ad (entget (setq an (entnext an)))
)
)
(if ToErase (entdel en))
)
)
)
)Also "quick & untested". :|
-
ok, how do I call it?
-
ok, how do I call it?
1 888 THE SWAMP
-
(defun _EraseBlockReferencesWithNullAttributeValue (blockname attributetag / ss i e)
(if (setq ss (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 blockname))))
(repeat (setq i (sslength ss))
(if
(vl-some
(function (lambda (a)
(and (eq (strcase (vla-get-tagstring a)) (strcase attributetag))
(eq (vla-get-textstring a) "")
)
)
)
(vlax-invoke (vlax-ename->vla-object (setq e (ssname ss (setq i (1- i))))) 'GetAttributes)
)
(entdel e)
)
)
)
(princ)
)
Thanks, This works great!
-
ok, how do I call it?
Same way as you do with Alan's code, the function name simply has a _A suffix to differentiate it from Alan's.
1 888 THE SWAMP
Is that true? I didn't know there was a hotline! :lmao:
-
Nice lisp
I've been trying to make a couple of edits, so that instead of erasing the selection set it instead moves them to a defined layer.
The first bit was easy, the second bit is easy as long as the layer exists in the drawing. So I have been trying to add code to check existence and make the layer if necessary but have ended up with a syntax error.
the first bit is this:
; (entdel e)
(command "_.CHPROP" e
"" "_LA" "Clashing-Null" "")
and this is the code i have been trying to integrate:
(command "layer" "F" "CLASHING_LEVELS" ^C
)
(command ".-layer" "c" "6" "CLASHING_LEVELS" "")
could some one please show me the correct place to put this code?
Also whilst I'm at it, it would be great is the selection set would filter out any blocks which are already on any layers prefixed with 'clashing-' beforehand.
Thanks
P
-
You mean like this?
(defun _EraseBlockReferencesWithNullAttributeValue_A (blockname attributetag / ss n en ed an ad ToErase)
(if (not (tblsearch "LAYER" "CLASHING-Null")) (command "LAYER" "N" "CLASHING-Null" "") ) (command "layer" "F" "CLASHING_LEVELS" ^C) (command ".-layer" "c" "6" "CLASHING_LEVELS" "")
(if (setq ss (ssget "_X"
(list '(0 . "INSERT") '(66 . 1) (cons 2 blockname) '(8 . "~CLASHING-*"))
)
)
(progn
(setq n (sslength ss))
(while (> (setq n (1- n)) -1)
(setq en (ssname ss n)
ed (entget en)
ToErase nil
ad (entget (setq an (entnext en)))
)
(while (and (not ToErase) (eq (cdr (assoc 0 ad)) "ATTRIB"))
(setq ToErase (and (eq (cdr (assoc 2 ad)) attributetag) (wcmatch (cdr (assoc 1 ad)) ""))
ad (entget (setq an (entnext an)))
)
)
(if ToErase
;; (entdel en)
(entmod (subst '(8 . "CLASHING-Null") (assoc 8 ed) ed))
)
)
)
)
)
-
Or if you prefer alan's VL code, here's a slight optimization of his as well as including your changes:
(vl-load-com)
(defun _EraseBlockReferencesWithNullAttributeValue (blockname attributetag / ss)
(if (not (tblsearch "LAYER" "CLASHING-Null"))
(command "LAYER" "N" "CLASHING-Null" "")
)
(command "layer" "F" "CLASHING_LEVELS" ^C)
(command ".-layer" "c" "6" "CLASHING_LEVELS" "")
(setq blockname (strcase blockname)
attributetag (strcase attributetag)
)
(if (and (ssget "_X"
(list '(0 . "INSERT") '(66 . 1) (cons 2 blockname) '(8 . "~[Cc][Ll][Aa][Ss][Hh][Ii][Nn][Gg]-*"))
)
(setq ss (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
)
(progn
(vlax-for e ss
(if (vl-some (function (lambda (a)
(and (eq (strcase (vla-get-TagString a)) attributetag)
(eq (vla-get-TextString a) "")
)
)
)
(vlax-invoke (vlax-ename->vla-object (setq e (ssname ss (setq i (1- i))))) 'GetAttributes)
)
(vla-put-Layer e "CLASHING-Null")
)
)
(vla-Delete ss)
)
)
(princ)
)
-
thanks Irneb. Thats brilliant.
Your version works perfectly but your version of Alan's errors:
Command: (_EraseBlockReferencesWithNullAttributeValue "PD" "LEVEL")
bad argument type: numberp: nil
Command: (_EraseBlockReferencesWithNullAttributeValue_A "PD" "LEVEL")
nil
I don't know why.
Thanks!
P :-)