Purge de bloc : je cherche mon erreur

[Tramber]

(vlax-for iii *blocks*
     (if(wcmatch (vla-get-Name iii) "Temp_*")
(vl-catch-all-apply(function(lambda()(vla-delete iii)))))) 

 

Bonjour,

 

J'ai voulu faire le plus court possible pour purger des blocs. Ici ceux avec nom commenacant par "Temp_".

 

(*blocks* est bien sur la collection de bloc de l'Activedocument)

 

Ca n'a pas l'air de fonctionner. Suis-je trop naÏf ! Sans doute...

[(gile)]

Salut,

 

Tu dois avoir des blocs imbriqués et tu ne peux pas supprimer un bloc enfant sans avoir d'abord supprimé tous ses blocs parents.

 

Une solution est de répéter vlax-for jusqu'à ce qu'il ne retourne plus que des vl-catch-all-error-p.

 

(while
 (vl-position
   nil
   ((lambda (/ lst)
      (vlax-for b *blocks*
 (if (wcmatch (vla-get-Name b) "Temp_*")
   (setq lst (cons (vl-catch-all-apply 'vla-Delete (list b)) lst))
 )
      )
      lst
    )
   )
 )
)

[Tramber]

Salut et merci.

 

En effet, j'ai aussi cela à gérer. Donc je me suis intéressé à cette routine et vais la regarder de plus près bientôt.

 

Et je m'autorise à penser que l'ordre de fabrication des blocs dans le dessin est important car, a priori, elle ne fonctionne pas dans mon cas, la purge reste au premier niveau.

 

Sauf erreur (j'y reviendrai), ca ne tourne pas mieux que ma routine.

Est-ce possible (je le crois, il est trop tard pour la lucidité) que l'ordre dans la collection compte ?

En effet, j'ai déclaré les parents avant les enfants dans mon cas.

 

Belle routine en tous cas.

[(gile)]

Sauf erreur (j'y reviendrai), ca ne tourne pas mieux que ma routine.

Si ça ne marche pas mieux, c'est qu'il y a autre chose que l'imbrication.

La boucle tente de supprimer tous les blocs qui retourne T à wcmatch (comme ton expression) et recommence tant qu'elle arrive à en supprimer.

 

Est-ce possible (je le crois, il est trop tard pour la lucidité) que l'ordre dans la collection compte ?

Si on traite une liste triée par ordre 'généalogique' on devrait pouvoir tout purger en une seule passe.

[Tramber]

Ok, je vais réfléchir.

Ce qui me trouble, c'est la "purgeabilité" de blocs toujours présents (je le constate en lancant PURGER).

[krunch]

Ce qui fait la "purgeabilité" c'est d'abord le fait que le bloc n'ait plus de référence insérée dans le dessin.

 

Sinon il est possible d'accéder au niveau le + haut d'un bloc, mais en passant par la RefBloc (en cherchant les parents soit avec OwnerId soit avec le code 330).. Pas sûr que ce soit plus simple

 

Et sinon enfin il y a une fonction (acet-block-purge bna), je ne sais pas ce qu'elle apporte de plus

 

 

 

[Edité le 17/2/2011 par krunch]

[(gile)]

Ok, je vais réfléchir.

Ce qui me trouble, c'est la "purgeabilité" de blocs toujours présents (je le constate en lancant PURGER).

 

J'ai refait des tests, chez moi la boucle purge bien tout les blocs "purgeables".

 

Peux tu m'envoyer un exemple qui pose problème ?

 

[Tramber]

C'est fait !

 

Je n'arrive pas bien à comprendre, quand même. Car j'ai aussi fait l'essai sur une imbrication faite à la main, comme un dessinateur. Et là non plus je ne dépasse pas le 1er niveau...

 

J'espère qu'il n'y a rien que je comprenne de travers.

 

PS : on doit faire bien attention à la casse sur les noms. C'est un sujet de discussion, non ? C'est bizarre pour un bloc ou je dis (encore) une ...onnerie ?

 

[Edité le 17/2/2011 par Tramber]

[(gile)]

C'est très curieux, ça fonctionne très bien sur 2011 mais pas sur 2010 ou 2007.

C'est comme si une mise à jour ne se faisait pas : quand on supprime un bloc parent les blocs enfant sont toujours considérés comme référencés... :casstet:

 

on doit faire bien attention à la casse sur les noms. C'est un sujet de discussion, non ? C'est bizarre pour un bloc

Normal, wcmatch est sensible à la casse.

[Tramber]

C'est vrai. Ma reflexion sur la casse est idiote.

 

Alors je ne rêvais pas. Merci d'avoir regardé.

 

Est-ce une routine que tu as créé recemment, sur 2011 ?

As-tu déjà publié une autre routine qui pourrait fonctionner ?

[(gile)]

Est-ce une routine que tu as créé recemment, sur 2011 ?

Oui, hier soir après avoir lu ton message.

 

As-tu déjà publié une autre routine qui pourrait fonctionner ?

Non, pas en LISP. Je vais essayer de regarder du côté des codes DXF, la liste d'un BLOCK_RECORD contient les enames des références de ce bloc.

[Patrick_35]

Salut

 

Et quelque chose dans ce style ?

 

(defun effbl(bl / ent)
 (vlax-for ent bl
   (and (eq (vla-get-objectname "AcDbBlockReference") (effbl ent))
 )
 (vla-delete bl)
)

(vlax-for bl (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
 (and (wcmatch (strcase (vla-get-name bl)) "TEMP_*") (effbl bl))
)

 

ps : non testé

 

@+

[(gile)]

Salut Patrick_35,

 

Ce n'est pas si simple que ça.

Même en corrigeant certaines erreurs dans ton code il ne peut fonctionner : ta fonction récursive n'a pas de condition d'arrêt (on re-parcourt la table des blocs à chaque appel)

 

Mais la solution semble être dans ce sens quand on supprime une définition, il faut d'abord supprimer les références de blocs (enfants) qu'elle contient.

Mais auparavant, il faut être sûr que cette définition n'est pas référencée.

 

Je pense avoir trouvé quelque chose qui fonctionne (même sur 2007 et 2010) et qui, malgré un code plus long, devrait être plus rapide : utiliser vl-catch-all-apply en boucle est couteux (et un peu "ça passe ou ça casse").

 

(defun gc:massoc (code alst)
 (if (setq alst (member (assoc code alst) alst))
   (cons (cdar alst) (gc:massoc code (cdr alst)))
 )
)

(defun gc:IsReferenced (bname / blk)
 (and
   (setq blk (tblobjname "BLOCK" bname))
   (vl-some 'entget (gc:massoc 331 (entget (cdr (assoc 330 (entget blk))))))
 )
)

(defun gc:KillChildren (blk)
 (vlax-for o blk
   (if	(= (vla-get-ObjectName o) "AcDbBlockReference")
     (vla-Delete o)
   )
 )
)

(defun gc:PurgeBlock (pat / blk name blst loop)
 (while (setq blk (tblnext "BLOCK" (not blk)))
   (if	(wcmatch (setq name (cdr (assoc 2 blk))) pat)
     (setq blst (cons name blst))
   )
 )
 (setq loop T)
 (while (and loop blst)
   (setq loop nil)
   (foreach n blst
     (if (not (gc:IsReferenced n))
(progn
  (gc:KillChildren (vla-item *blocks* n))
  (vla-delete (vla-item *blocks* n))
  (setq blst (vl-remove n blst))
  (setq loop T)
)
     )
   )
 )
)

[Tramber]

Bon, les gars, au début je pensais à mes enfants (!) mais avais déjà la question des parents à résoudre.

Mais c'est vachement bien puisque le sujet a dérive sur le sujet des enfants. Je vais essayer cette dernière fonction quand je l'aurais bien comprise (celle du début, c'est ok, je tâcherai de me souvenir de la belle astuce du vl-position.).

Pour cela voici ma question à toi, (gile) :

C'est quoi ces histoires de pointeurs dans le DXF 330 et 331 ?

Je suis curieux pour ce test dont je ne comprends pas la destination à brûle-pour-point.

 

 

[(gile)]

Souvent, passer par les listes DXF est plus riche en renseignements que d'autres méthodes, un dwg est complètement décrit par la base de données DXF et pratiquement tout est accessible (sauf les solides dont le code est crypté).

 

Quand on fait : (tblobjname "BLOCK" "NomDuBloc") l'objet retourné est du type BLOCK (AcDbBlockBegin).

 

Le groupe 330 de la liste DXF d'un BLOCK pointe sur l'objet BLOCK_RECORD (AcDbBlockTableRecord) c'est l'objet équivalent de celui retourné par :

(vla-Item *blocks* "NomDuBlock")

 

Par exemple pour le BLOCK_RECORD de l'espace objet (vla-get-ModelSpace *acdoc*) :

(cdr (assoc 330 (entget (tblobjname "block" "*Model_Space"))))

 

C'est là que DXF prend l'avantage sur COM : la liste DXF du BLOCK_RECORD contient un pointeur vers chaque référence du bloc dans le dessin (groupe 331), y compris les références insérées dans des blocs (il y a l'équivalent en .NET avec la méthode BlockTableRecord.GetBlockReferenceIds())

 

Il reste une astuce, quand un objet AutoCAD est effacé, il n'est pas supprimé de la base de données (pour pouvoir annuler), pour savoir s'il est effacé, il y a la fonction vlax-erased-p ou encore tenter un entget (qui retourne nil si l'objet est effacé)

 

Essaye la séquence suivante :

(setq pt (entmakex '((0 . "POINT") (10 10. 20. 0.))))

(entget pt)

(entdel pt) ; efface le point

(entget pt) ; retourne nil

(entdel pt) ; restaure le point

'entget pt)

 

PS : recopie la routine, j'avais oublié une condition d'arrêt pour la boucle while.

[Tramber]

PS : recopie la routine, j'avais oublié une condition d'arrêt pour la boucle while.

 

T'inquiètes, je l'avais pas implémentée, ca sera pour dimanche je crois !

 

Merci pour les renseignements... et les codes :cool:

[(gile)]

Petite optimisation et groupement en une unique routine.

 

Edit: ajout d'un contrôle pour écarter les xrefs et leurs blocs.

 

;; gc:PurgeBlock
;; Purge les blocs dont le nom correspond au modèle (insensible à la casse)
;;
;; Argument
;; pat : un modèle pour le nom de bloc, accepte les caractères génériques ("*" pour tous)

(defun gc:PurgeBlock (pat / massoc blk name blst loop)
 (vl-load-com)

 (defun massoc	(code alst)
   (if	(setq alst (member (assoc code alst) alst))
     (cons (cdar alst) (massoc code (cdr alst)))
   )
 )

 (while (setq blk (tblnext "BLOCK" (not blk)))
   (if
     (and
(wcmatch (strcase (setq name (cdr (assoc 2 blk)))) (strcase pat))
(< (cdr (assoc 70 (setq elst (entget (tblobjname "BLOCK" name))))) 4)
     )
     (setq blst (cons (cdr (assoc 330 elst)) blst))
   )
 )
 (setq loop T)
 (while (and loop blst)
   (setq loop nil)
   (foreach b blst
     (or (vl-some 'entget (massoc 331 (entget b)))
(progn
  (setq blk (vlax-ename->vla-object b))
  (vlax-for o blk
    (if	(= (vla-get-ObjectName o) "AcDbBlockReference")
      (vla-Delete o)
    )
  )
  (vla-delete blk)
  (setq blst (vl-remove b blst))
  (setq loop T)
)
     )
   )
 )
)

[Patrick_35]

Salut

 

 

L'idée est de parcourir la table des blocs, d'y regarder s'il y a des blocs imbriqués et d'effacer ces références le cas échéant.

La condition d'arrêt --> Pas d'insertion de bloc

 

@+

[(gile)]

J'avais fait un test en vitesse (j'allais poster quand j'ai vu ton message) et j'ai dû faire une bêtisé en corrigeant ton code parce que j'ai provoqué un dépassement de la pile.

 

Je viens de refaire des tests et je me heurte au même problème "d'objet référencé".

De toutes façons il me semble qu'il ne répond pas à la demande de Tramber qui veut seulement purger les blocs non référencés.

 

Je suis assez content de mon code car je pense avoir trouver un moyen fiable pour purger les blocs imbriqués.

[Tramber]

Je suis assez content de mon code car je pense avoir trouver un moyen fiable pour purger les blocs imbriqués.

 

Salut les gars, Je m'étonnais justement. J'ai longtemps négligé de lire régulièrement les posts sur CADxp, ca se compte en années.

Je me suis dit que je trouverais bien un peu d'inspiration pour gérer plus tard les blocs imbriqués.

 

En fait je dois dire que je suis surpris car vous semblez me montrer qu'il n'y a jamais eu beaucoup de discussions et de demandes (satisfaites) pour ce sujet de la purge des blocs.

Et le coup du vl-position pour traiter "tant qu'elle a encore à traiter" est élégant.

 

Par contre, je n'ai pas tout compris pour le fonctionnement de la dernière routine :

La première boucle liste toutes les références ayant un blocksrecords.

 

Ensuite nous rentrons dans une boucle et l'on vérifie qu'il n'y a aucun attribut (331) . C'est ça ?

Puis le (vlax-for o blk

permet d'effacer tous les enfants du premier niveau.

 

Mais alors, comment la routine "sait-elle" ce qui est purgeable ? La construction de blst m'échappe-t-elle ?

Je crois que oui.

 

Hoppla

En tous cas, ca a l'air de très bien marcher.

...et puis, quel étonnement pour la 2011...

 

 

 

[Edité le 18/2/2011 par Tramber]

[(gile)]

Salut,

 

Salut les gars, Je m'étonnais justement. J'ai longtemps négligé de lire régulièrement les posts sur CADxp, ca se compte en années.

Je me suis dit que je trouverais bien un peu d'inspiration pour gérer plus tard les blocs imbriqués.

 

En fait je dois dire que je suis surpris car vous semblez me montrer qu'il n'y a jamais eu beaucoup de discussions et de demandes (satisfaites) pour ce sujet de la purge des blocs.

Il y avait eu ce challenge sur CADxp et ce sujet sur exmateria.

Mais c'est vrai que tout ce que j'ai pu lire utilise toujours la méthode consistant à faire n purges successives, n étant arbitrairement choisi dans l'espoir d'être suffisant pour purger tous les éléments imbriqués sans faire trop de purges inutiles...

 

De mon côté, avec .NET j'avais trouvé un moyen fiable utilisant la méthode Database.Purge qui supprime d'une collection d'ObjectId tous ceux qui correspondent à des objets non purgeables (référencés).

J'ai implémenté cette méthode pour définir une fonction LISP (voir ici).

 

Et le coup du vl-position pour traiter "tant qu'elle a encore à traiter" est élégant

Tu parles de la routine réponse #1 ? Celle qui semble ne fonctionner que sur 2011 ?

 

Par contre, je n'ai pas tout compris pour le fonctionnement de la dernière routine :

La première boucle liste toutes les références ayant un blocksrecords.

 

Ensuite nous rentrons dans une boucle et l'on vérifie qu'il n'y a aucun attribut (331) . C'est ça ?

Puis le (vlax-for o blk

permet d'effacer tous les enfants du premier niveau.

 

Mais alors, comment la routine "sait-elle" ce qui est purgeable ? La construction de blst m'échappe-t-elle ?

 

Effectivement, tu n'as pas tout compris (voire pas compris du tout) mais après une bonne nuit, tu as peut-être, aujourd'hui, les idées plus claires. ;)

En complément des explications données réponse #14, je vais essayer d'expliquer avec un exemple simple.

 

Soit un bloc A0 inséré dans un bloc A1 lui même inséré dans un bloc A2.

Les espaces objet et papier du dessin ne contienent aucune référence des blocs A1 et A2, pour A0 on envisagera les deux cas.

 

Je lance (gc:purgeblock "A#") :

(while (setq blk (tblnext "BLOCK" (not blk)))
   (if	(wcmatch (strcase (setq name (cdr (assoc 2 blk)))) (strcase  pat))
     (setq blst (cons (cdr (assoc 330 (entget (tblobjname "BLOCK" name)))) blst))
   )
 )

Cette boucle while parcourt la table des blocs, et pour chaque définition de bloc dont le nom correspond au modèle (A + un chiffre), le BLOCK_RECORD est ajouté à la liste blst.

Pour notre exemple, elle contient donc les BLOCK_RECORD de A0, A1 et A2.

 

La seconde boucle while traite cette liste avec comme condition d'arrêt que la liste soit vide ou que le "drapeau" loop soit nil.

On assigne T à loop avant de lancer la boucle et au début de chaque itération on remettra loop à nil.

Chaque itération parcourt la liste blst (foreach ...) et pour chaque BLOCK_RECORD on fait le test qui nous dit le bloc est référencé :

(or (vl-some 'entget (massoc 331 (entget B))) ...)

(massoc 331 (entget B)) retourne la liste des ENAMEs de toutes les références du bloc insérées dans le dessin (espace ou définition de bloc).

Mais comme explique réponse #14, certaines de ces références peuvent avoir été effacées et être toujours présentes dans la base de donnée. Dans ce cas, entget retourne nil.

Donc, (vl-some 'entget (massoc 331 (entget B)) retourne T s'il existe au moins une référence non effacée du bloc b.

Dans notre exemple, cette expression retourne T pour A0 (inséré dans A1) et A1 (inséré dans A2) et nil pour A2.

A2 est donc traité :

	(progn
  (setq blk (vlax-ename->vla-object B))
  (vlax-for o blk
    (if	(= (vla-get-ObjectName o) "AcDbBlockReference")
      (vla-Delete o)
    )
  )
  (vla-delete blk)
  (setq blst (vl-remove b blst))
  (setq loop T)
)

On supprime toutes les références de bloc insérées dans A2 (référence à A1).

On supprime la définition de bloc (BLOCK_RECORD) de A2 de la table

On supprime A2 de blst

On remet loop à T pour relancer une boucle.

 

Lors de la seconde boucle, il n'y a plus que A1 et A0 dans la liste blst.

A1 est non référencé => la référence à A0 dans A1 est supprimée => A1 est supprimé de la table et de la liste => loop = T

 

Troisième boucle A0 est traité :

- s'il n'est pas référencé (dans un espace) il est supprimé => loop = T mais blst est vide => la boucle s'arrête.

- s'il est référencé, il n'est pas supprimé => loop = nil => la boucle s'arrête.

[Tramber]

Pour les boucles et tout le reste, j'ai bien compris. C'est pas un problème.

C'est tout simplement (vl-some 'entget (massoc 331 (entget b))) et ce code 331 qui m'échappait totalement,

A lire la référence DXF, je croyais qu'on parlait d'attributs dont je pense savoir qu'ils sont juste dérrière le BlockBegin.

 

Je vais me repencher sur ces 330 et 331. C'est vraiment ce 331 que j'interprétais maL

 

En tous cas le résultat est excellent :)

 

J'ai vu le Challenge 30. Je me souviens maintenant... j'avais oublié que je l'avais lu et y avais fait une intervention fort importante sur les moteurs à plat (notre musée déménage, j'ai passé toute la journée d'aujourd'hui à déplacer des épaves de 2CV, c'était marrant je suis impliqué dans mon assoc et fustige ceux qui veulent comparer cette merveille avec des Porshce et des Ferrari).

Quand je vois la qualité des interventions, je préfère me servir de vos travaux (et les comprendre, question pas de fierté mais disons d'honneur) que de m'essayer à des solutions bancales.

 

Chapeau pour tout. Et mystère intriguant voire fascinant sur la routine de la réponse n°1 compatible uniquement 2011...

[Tramber]

Au fait, il y a un truc que je n'ai pas dit :P

Dans le sujet, je disais que ma routine ne marchait pas. Elle marchait bien, évidemment, mais pour le 1er niveau.

J'avais juste mal écrit mon Pattern :calim:

 

C'était juste pour préciser. Connaissant le niveau d'imbrication, je me disais que je l'aurais faite tourner 1 ou 2 fois.

Mais le sujet a formidablement dérivé.

 

Hoppla bon dimanche

[lili2006]

Bonsoir à toutes et tous,

 

Sur mon civil 3D 2011 =>

 

Commande:

Commande: (LOAD "C:/Users/Lilian/Desktop/PurgeBlock.lsp") GC:PURGEBLOCK

Commande: PurgeBlock

Commande inconnue "PURGEBLOCK". Appuyez sur F1 pour obtenir de l'aide.

Commande:

Commande: (LOAD "C:/Users/Lilian/Desktop/PurgeBlock.lsp") GC:PURGEBLOCK

Commande: PURGEBLOCK

Commande inconnue "PURGEBLOCK". Appuyez sur F1 pour obtenir de l'aide.

 

Il y a pourtant bien des blocs à purger ??!!

[(gile)]

Je vais me repencher sur ces 330 et 331. C'est vraiment ce 331 que j'interprétais maL

 

Relis les réponses #14 et #20, et, surtout, teste, inspecte les listes DXF :

(setq blk (tblobjname "block" "Temp_marche_2d"))
(entget blk)
(setq blkRec (cdr (assoc 330 (entget blk))))
(entget blkRec)
(setq blkRef (cdr (assoc 331 (entget blkRec))))
(entget blkRef)
(entget (cdr (assoc 330 (entget blkRef))))

 

lili2006,

 

Quand un nom de fonction LISP n'a pas le préfixe 'c:', il ne peut pas être appelé comme un commande native AutoCAD, il s'agit d'une fonction destinée à être utilisée dans d'autre LISP.

 

De plus, dans ce cas, la fonction requiert un argument : une chaine de caractère stipulant le nom du bloc ou utilisant les caractères génériques pour cibler plusieurs blocs.

 

Si tu entre une expression LISP valide en ligne de commande, elle sera correctement interprétée.

Essaye l'expression suivante pour purger tous les blocs ("*" pour tous) :

(gc:PurgeBlock "*")

 

Ou définit toi une commande en utilisant cette fonction :

(defun c:URB () (gc:PurgeBlock "*") (princ))

et tu pourras utiliser URB directement en ligne de commande.