ssget filter problem

Greetings.

I am new to this whole autolisp world (or programming for that matter)

Anyways, here is what I am trying to do:

A command that would burst blocks according to a set of filters.

Heres my code:

(defun c:ppx ( / p )
(setq p (ssget '((0 . "INSERT") (-4 . "<OR") (2 . "S??A") (2 . "S??B") (-4 . "OR>"))))
(if (/= p nil)
(progn
(sssetfirst nil p)
(c:burst)
)
(progn
(princ "\n¡No más elementos!")(princ)
)
)
(princ "\nFinalizado.")(princ)
) 

Attached file contains several blocks for which i intent to use this command.

If tested on them, youll see that blocks named as S12A and S12B are correctly selected, but all the other blocks contained in the attached file are not.

So I was wondering if anyone could help me to see if I am missing anything on those other blocks, or to explain me why the filters are not considering those other blocks, or if I am doing anything wrong.

And thanks in advance

test.dwg

The blocks in your drawing are dynamic, therefore, a new anonymous block definition will be automatically created & referenced for every block reference with a different set of dynamic block parameter values.

There are various ways to include the appropriate anonymous block references in the selection, and the method that you follow may depend on whether the program will be entirely automated or will prompt the user for a selection of block references to process. I describe various methods and provide examples in the description of my Get Anonymous References function.

For your task, I would also suggest using my LM:Burst function (which may be supplied with a selection set directly), as this function performs much faster than the standard BURST command and will also exclude invisible attributes.

For your specific task, I have tweaked my LM:getanonymousreferences function to allow a wildcard argument, meaning the code could be:

(defun c:ppx nil
   (LM:burst
       (ssget "_:L"
           (list '(0 . "INSERT")
               (cons 2
                   (apply 'strcat
                       (cons "S??[AB]"
                           (mapcar '(lambda ( x ) (strcat ",`" x))
                               (LM:getanonymousreferences "S??[AB]")
                           )
                       )
                   )
               )
           )
       )
   )
)

;; Get Anonymous References  -  Lee Mac
;; Returns the names of all anonymous references of a block.
;; blk - [str] Block name/wildcard pattern for which to return anon. references

(defun LM:getanonymousreferences ( blk / ano def lst rec ref )
   (setq blk (strcase blk))
   (while (setq def (tblnext "block" (null def)))
       (if
           (and (= 1 (logand 1 (cdr (assoc 70 def))))
               (setq rec
                   (entget
                       (cdr
                           (assoc 330
                               (entget
                                   (tblobjname "block"
                                       (setq ano (cdr (assoc 2 def)))
                                   )
                               )
                           )
                       )
                   )
               )
           )
           (while
               (and
                   (not (member ano lst))
                   (setq ref (assoc 331 rec))
               )
               (if
                   (and
                       (entget (cdr ref))
                       (wcmatch (strcase (LM:al-effectivename (cdr ref))) blk)
                   )
                   (setq lst (cons ano lst))
               )
               (setq rec (cdr (member (assoc 331 rec) rec)))
           )
       )
   )
   (reverse lst)
)
                       
;; Effective Block Name  -  Lee Mac
;; ent - [ent] Block Reference entity

(defun LM:al-effectivename ( ent / blk rep )
   (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
       (if
           (and
               (setq rep
                   (cdadr
                       (assoc -3
                           (entget
                               (cdr
                                   (assoc 330
                                       (entget
                                           (tblobjname "block" blk)
                                       )
                                   )
                               )
                              '("AcDbBlockRepBTag")
                           )
                       )
                   )
               )
               (setq rep (handent (cdr (assoc 1005 rep))))
           )
           (setq blk (cdr (assoc 2 (entget rep))))
       )
   )
   blk
)

;;------------------------=={ Burst Upgraded }==------------------------;;
;;                                                                      ;;
;;  This program operates in much the same way as the familiar          ;;
;;  Express Tools' Burst command, however invisible block attributes    ;;
;;  are not displayed with the resulting exploded components.           ;;
;;                                                                      ;;
;;  Following a valid selection of blocks to burst, the program         ;;
;;  converts all visible single-line & multi-line attributes into Text  ;;
;;  and MText respectively, before proceeding to explode the block,     ;;
;;  and deleting the original attribute objects.                        ;;
;;                                                                      ;;
;;  The core function accepts a selection set argument and may hence    ;;
;;  be called from within other custom programs to burst all blocks     ;;
;;  in a supplied selection set.                                        ;;
;;                                                                      ;;
;;  The methods used by the program should also perform much faster &   ;;
;;  more efficiently than those used by the Express Tools' Burst.lsp.   ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2014  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2010-11-25                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2013-08-29                                      ;;
;;                                                                      ;;
;;  - Program entirely rewritten.                                       ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    2014-02-23                                      ;;
;;                                                                      ;;
;;  - Program restructured to accept selection set argument.            ;;
;;  - Program now also explodes non-attributed blocks.                  ;;
;;----------------------------------------------------------------------;;

(defun c:iburst nil
   (LM:startundo (LM:acdoc))
   (LM:burst
       (LM:ssget "\nSelect blocks to burst: "
           (list "_:L"
               (cons '(0 . "INSERT")
                   (
                       (lambda ( / def lst )
                           (while (setq def (tblnext "block" (null def)))
                               (if (= 4 (logand 4 (cdr (assoc 70 def))))
                                   (setq lst (vl-list* "," (cdr (assoc 2 def)) lst))
                               )
                           )
                           (if lst (list '(-4 . "<NOT") (cons 2 (apply 'strcat (cdr lst))) '(-4 . "NOT>")))
                       )
                   )
               )
           )
       )
   )
   (LM:endundo (LM:acdoc))
   (princ)
)

(defun LM:burst ( sel / col idx lay lin lst obj )
   (if (= 'pickset (type sel))
       (repeat (setq idx (sslength sel))
           (setq obj (vlax-ename->vla-object (ssname sel (setq    idx (1- idx))))
                 lay (vla-get-layer obj)
                 col (vla-get-color obj)
                 lin (vla-get-linetype obj)
           )
           (if (and (= "AcDbBlockReference" (vla-get-objectname obj))
                    (vlax-write-enabled-p obj)
                    (not (vl-catch-all-error-p (setq lst (vl-catch-all-apply 'vlax-invoke (list obj 'explode)))))
               )
               (progn
                   (foreach att (vlax-invoke obj 'getattributes)
                       (if (vlax-write-enabled-p att)
                           (progn
                               (if (= "0" (vla-get-layer att))
                                   (vla-put-layer att lay)
                               )
                               (if (= acbyblock (vla-get-color att))
                                   (vla-put-color att col)
                               )
                               (if (= "byblock" (strcase (vla-get-linetype att) t))
                                   (vla-put-linetype att lin)
                               )
                           )
                       )
                       (if (= :vlax-false (vla-get-invisible att))
                           (   (if (and (vlax-property-available-p att 'mtextattribute) (= :vlax-true (vla-get-mtextattribute att)))
                                   LM:burst:matt2mtext 
                                   LM:burst:att2text
                               )
                               (entget (vlax-vla-object->ename att))
                           )
                       )
                   )
                   (foreach new lst
                       (if (vlax-write-enabled-p new)
                           (if (= "AcDbAttributeDefinition" (vla-get-objectname new))
                               (vla-delete new)
                               (progn
                                   (if (= "0" (vla-get-layer new))
                                       (vla-put-layer new lay)
                                   )
                                   (if (= acbyblock (vla-get-color new))
                                       (vla-put-color new col)
                                   )
                                   (if (= "byblock" (strcase (vla-get-linetype new) t))
                                       (vla-put-linetype new lin)
                                   )
                               )
                           )
                       )
                   )
                   (vla-delete obj)
               )
           )
       )
   )
   (princ)
)

(defun LM:burst:removepairs ( itm lst )
   (vl-remove-if '(lambda ( x ) (member (car x) itm)) lst)
)

(defun LM:burst:remove1stpairs ( itm lst )
   (vl-remove-if '(lambda ( x ) (if (member (car x) itm) (progn (setq itm (vl-remove (car x) itm)) t))) lst)
)
 
(defun LM:burst:att2text ( enx )
   (entmakex
       (append '((0 . "TEXT"))
           (LM:burst:removepairs '(000 002 070 074 100 280)
               (subst (cons 73 (cdr (assoc 74 enx))) (assoc 74 enx) enx)
           )
       )
   )
)

(defun LM:burst:matt2mtext ( enx )
   (entmakex
       (append '((0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText"))
           (LM:burst:remove1stpairs  '(001 007 010 011 040 041 050 071 072 073 210)
               (LM:burst:removepairs '(000 002 042 043 051 070 074 100 101 102 280 330 360) enx)
           )
       )
   )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
   (princ msg)
   (setvar 'nomutt 1)
   (setq sel (vl-catch-all-apply 'ssget arg))
   (setvar 'nomutt 0)
   (if (not (vl-catch-all-error-p sel)) sel)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
   (LM:endundo doc)
   (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
   (while (= 8 (logand 8 (getvar 'undoctl)))
       (vla-endundomark doc)
   )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
   (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (LM:acdoc)
)
(vl-load-com) (princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

I shall update the function on my site shortly.

Wah! Thanks a lot! Works perfectly!

Just a side question: are those extra blocks named something like *U something?

Wah! Thanks a lot! Works perfectly!

Excellent - you're welcome!

Just a side question: are those extra blocks named something like *U something?

Indeed they are - you can see the block name using the AutoCAD LIST command.

Hi ,Lee

Command: (setq obj (vlax-ename->vla-object (car (entsel "\nSelect Block: "))))
Select Block: #<VLA-OBJECT IAcadBlockReference 0b68d8d4>

I use your great Dy block function.

(LM:getvisibilityparametername obj)

I get : Switch symbol

Switch symbol have more visibility state { switch type1 ,switch type2 , switch type3 ,switch type4)

(setq blkvb (LM:getvisibilitystate obj))

I get: "swith type2"

I want get all Entity in VS "swith type2" , not get all Entity in Dy block.

I want get all Entity in VS "swith type2" , not get all Entity in Dy block.

To confirm, you are looking to obtain only the entities in the block definition which are displayed when visibility state 'switch type2' is set?

To confirm, you are looking to obtain only the entities in the block definition which are displayed when visibility state 'switch type2' is set?

Yes ,Lee. That's it.

Yes ,Lee. That's it.

• Insert a temporary reference of the dynamic block.
  
• Set the visibility state parameter to 'switch type2'.
  
• Retrieve the anonymous block name of the temporary reference.
  
• Iterate over the definition of the anonymous block.

• Retrieve the anonymous block name of the temporary reference.
  
• Iterate over the definition of the anonymous block.

Thanks Lee, you mean : every entities is a anonymous block ?

Thanks Lee, you mean : every entities is a anonymous block ?

No - an anonymous block definition is automatically generated/used when the parameters of a dynamic block are altered. The components of the anonymous block definition corresponding to the selected visibility state are the entities that you require.

No - an anonymous block definition is automatically generated/used when the parameters of a dynamic block are altered. The components of the anonymous block definition corresponding to the selected visibility state are the entities that you require.

Depressed . Maybe need a example.

What is your code so far?

What is your code so far?

Hi Lee, How do this?

Iterate over the definition of the anonymous block.

Hi Lee, How do this?

Use the entnext function to iterate over all entities which follow the entity returned by the tblobjname function when supplied with the anonymous block name.

Use the entnext function to iterate over all entities which follow the entity returned by the tblobjname function when supplied with the anonymous block name.

Hi Lee ,Thanks. I test , but it's get all Entity in Dy block

not get all Entity in VS "swith type2" . See detail.

1.

(command "._-insert" "Switch_symbol" pause "" "" "")
(setq myblock (vlax-ename->vla-object (entlast)))

2.

(LM:SetVisibilityState myblock "swith type2")

3.

_$(setq bname(Vlax-Get myblock "Name"))
"*U6"

4.

Function1

(defun GetBlkEntlst1 (BlockName / en lst)
(if (setq en (tblobjname "BLOCK" BlockName))
	(while (setq en (entnext en)) (setq lst (cons en lst)))
)
(reverse lst)
)

Function2

(defun GetBlkEntlst2(blkname / en enlst)
(setq enlst (list (cdr (assoc -2 (tblsearch "block" blkname)))))
(while (setq en (entnext (car enlst)))
	(setq enlst (cons en enlst))
)
(reverse enlst)
)

Test

(GetBlkEntlst1 bname) 

Or

(GetBlkEntlst2 bname)

But it's get all Entity in Dy block

(
<Entity name: 7eef2620> 
<Entity name: 7eef2628>
<Entity name: 7eef2630>
<Entity name: 7eef2638>
<Entity name: 7eef2640>
<Entity name: 7eef2650>
<Entity name: 7eef2658>
<Entity name: 7eef2660>
<Entity name: 7eef2668>
<Entity name: 7eef2670>
<Entity name: 7eef2678>
<Entity name: 7eef2680>
<Entity name: 7eef2688> 
<Entity name: 7eef2690>
<Entity name: 7eef2698>
<Entity name: 7eef26a0>
<Entity name: 7eef26a8> 
<Entity name: 7eef26b0>
<Entity name: 7eef26b8> 
<Entity name: 7eef26c0> 
<Entity name: 7eef26c8>
<Entity name: 7eef26d0> 
<Entity name: 7eef26d8>
<Entity name: 7eef26e0>
<Entity name: 7eef26e8>
<Entity name: 7eef26f0> 
<Entity name: 7eef26f8>
)

Good effort

Try changing 'Function1' to:

(defun GetBlkEntlst1 ( blk / ent rtn )
   (if (setq ent (tblobjname "block" blk))
       (while (setq ent (entnext ent))
           (if (/= 1 (cdr (assoc 60 (entget ent))))
               (setq rtn (cons ent rtn))
           )
       )
   )
   (reverse rtn)
)

Good effort

 

Try changing 'Function1' to:

(defun GetBlkEntlst1 ( blk / ent rtn )
   (if (setq ent (tblobjname "block" blk))
       (while (setq ent (entnext ent))
           (if (/= 1 (cdr (assoc 60 (entget ent))))
               (setq rtn (cons ent rtn))
           )
       )
   )
   (reverse rtn)
)

Lee, Thank you for the compliment.

Thank you for your help .I must take a look at this changes.