Challenge30

[(gile)]

Salut,

 

Il s'agit de définir une routine qui retourne le plus bas niveau d'imbrication (entier) de tous les blocs du dessin courant.

 

Exemple :

http://img21.imageshack.us/img21/1279/challenge30.png

Le bloc "A" est un bloc simple.

"A" est imbriqué dans le bloc "B".

"B" est imbriqué dans le bloc "C".

"C" est imbriqué dans le bloc "D".

 

Si le dessin ne contient que des blocs "simples" (comme le bloc "A"), la routine retourne 1

Si le bloc le plus "complexe" du dessin est le bloc "B", la routine retourne 2.

Si le bloc le plus "complexe" du dessin est le bloc "C", la routine retourne 3.

Si le bloc le plus "complexe" du dessin est le bloc "D", la routine retourne 4.

 

Plusieurs blocs sont imbriqués dans les blocs "C" et "D".

Si les insertions de "A" dans "C" et "B" dans "D" n'influent pas sur le résultat à obtenir, elles peuvent influer sur le temps de traitement, elles peuvent donc servir à ceux qui voudraient faire des tests d'optimisation dans un deuxième temps*.

 

Challenge30.dwg contient les blocs "A", "B", "C" et "D".

 

* Il es plus facile d'optimiser une routine déboguée que de déboguer une routine optimisée.

[ElpanovEvgeniy]

Salut, (gile) :)

 

Il m'est difficile de comprendre ce sujet.

Montre deux images - jusqu'à et après...

[(gile)]

Hi Evgeniy,

 

I'll try to explain in english.

 

The routine have to return an integer: the deepest nesting level in a drawing block collection.

In the upper picture "A", "B", "C", "D" are blocks,

- if a drawing contains only "A" type blocks, the routine returns 1

- if a drawing contains also "B" type blocks, the routine returns 2 ("A" is nested in "B")

- if a drawing contains also "C" type blocks, the routine returns 3 ("A" is nested in "B" and "B" in "C")

- with the attached Challenge30.dwg, the routine returns 4

[zebulon_]

Bonjour,

 

Au sujet des blocs, est-ce qu'on peut se contenter de lire la table des blocs et de prendre ceux qui s'y trouve ou faut-il faire un (ssget "_X" '((0 . "INSERT")))) pour ne prendre que ceux qui sont insérés dans le fichier ?

 

Amicalement

Vincent

[Patrick_35]

Salut

 

Un premier exemple qui indique le niveau d'imbrication + les "sous-blocs" du bloc principal.

La recherche se fait dans la table des blocs.

Il est facile de modifier cette routine afin de sélectionner un bloc pour connaitre ses "sous-blocs".

 

(defun c:lvl(/ doc ele ent lst new nom tot lister nom_bl)

 (defun nom_bl(bl)
   (if (vlax-property-available-p bl 'effectivename)
     (vla-get-effectivename bl)
     (vla-get-name bl)
   )
 )

 (defun lister(ele / new)
   (or (member (car ele) tab) (setq tab (cons (car ele) tab)))
   (and (setq new (assoc (car ele) lst)) (lister (cdr new)))
   (and (setq new (cdr ele)) (lister new))
 )

 (setq doc (vla-get-activedocument (vlax-get-acad-object))
tot 0
 )
 (vlax-for bl (vla-get-blocks doc)
   (or (eq (vla-get-islayout bl) :vlax-true)
(eq (vla-get-isxref   bl) :vlax-true)
(wcmatch (setq nom (nom_bl bl)) "*|*,`**")
     (vlax-for ent bl
(if (eq (vla-get-objectname ent) "AcDbBlockReference")
  (if (setq ele (assoc nom lst))
    (or (member (nom_bl ent) ele)
      (setq new (append ele (list (nom_bl ent)))
	    lst (subst new ele lst)
      )
    )
    (setq lst (cons (list nom (nom_bl ent)) lst))
  )
)
     )
   )
 )
 (foreach ele lst
   (princ (strcat "\n\tLe bloc " (car ele)))
   (lister (cdr ele))
   (mapcar '(lambda(x)(princ (strcat " + " x))) tab)
   (setq tot (max tot (1+ (length tab)))
  tab nil
   )
 )
 (princ (strcat "\n\tNiveau d'imbrication max : " (itoa tot)))
 (princ)
)

 

Et une autre qui retourne que le niveau d'imbrication

 

(defun lvl(/ doc ele ent lst new nom tot lister nom_bl)

 (defun nom_bl(bl)
   (if (vlax-property-available-p bl 'effectivename)
     (vla-get-effectivename bl)
     (vla-get-name bl)
   )
 )

 (defun lister(ele / new)
   (or (member (car ele) tab) (setq tab (cons (car ele) tab)))
   (and (setq new (assoc (car ele) lst)) (lister (cdr new)))
   (and (setq new (cdr ele)) (lister new))
 )

 (setq doc (vla-get-activedocument (vlax-get-acad-object))
tot 0
 )
 (vlax-for bl (vla-get-blocks doc)
   (or (eq (vla-get-islayout bl) :vlax-true)
(eq (vla-get-isxref   bl) :vlax-true)
(wcmatch (setq nom (nom_bl bl)) "*|*,`**")
     (vlax-for ent bl
(if (eq (vla-get-objectname ent) "AcDbBlockReference")
  (if (setq ele (assoc nom lst))
    (or (member (nom_bl ent) ele)
      (setq new (append ele (list (nom_bl ent)))
	    lst (subst new ele lst)
      )
    )
    (setq lst (cons (list nom (nom_bl ent)) lst))
  )
)
     )
   )
 )
 (foreach ele lst
   (lister (cdr ele))
   (setq tot (max tot (1+ (length tab)))
  tab nil
   )
 )
 tot
)

 

ElpanovEvgeniy : About Challenge 29, I said list_up1's without double

 

ps : Les blocs anomymes sont écartés.

pps : pas le temps de revoir le challenge 29

 

@+

[zebulon_]

Bonjour,

 

Allez ! Je me lance... La recherche se fait dans la table des blocs. Je n'ai pas fait de filtre pour supprimer les xrefs.

 

(defun listprembloc (/ lst NEXT PREMS)
 ;; la liste des premiers éléments de chaque bloc de la table
 (if (setq PREMS (tblnext "BLOCK" T))
   (setq lst (list (cdr (assoc -2 PREMS))))
 )
 (while (setq NEXT (tblnext "BLOCK"))
   (setq lst (cons (cdr (assoc -2 NEXT)) lst))
 )
 lst
)

(defun successeur (e / succlst a)
 ;; renvoie la liste des successeurs de e
 (if (not e)
   (setq succlst (listprembloc))
   (while e
     (setq a (entget e))
     (if (= (cdr (assoc 0 a)) "INSERT")
       (progn
         (setq a (tblsearch "BLOCK" (cdr (assoc 2 a))))
         (setq succlst (cons (cdr (assoc -2 a)) succlst))
       )
     )
     (setq e (entnext e))
   )
 )
 succlst
)

(defun profondeur (e / slst s lh)
 (setq slst (successeur e))
 (foreach s slst
   (setq lh (cons (profondeur s) lh))
 )
 (if slst
   (+ 1 (apply 'max lh))  ;; le maximum de la hauteur des successeurs + 1
   0                      ;; 0 quand il n'y a plus de successeur
 )
)


(defun c:blimb (/)
 (alert (itoa (profondeur nil)))
) 

 

J'ai eu un peu de mal et j'espère que ce que j'ai écrit est correct. Je n'ai pas trop l'habitude d'utiliser la récursivité (et c'est un tort ;)), ni de manipuler des arbres.

 

Amicalement

Vincent

 

 

[Edité le 1/12/2009 par zebulon_]

[Bred]

Salut,

j'ai une solution mais je crois que c'étais (gile) qui me l'avais donné...

[ElpanovEvgeniy]

ElpanovEvgeniy : About Challenge 29, I said list_up1's without double

 

Je demande pardon. J'étais peu attentif...

[Patrick_35]

ElpanovEvgeniy : About Challenge 29, I said list_up1's without double

 

Je demande pardon. J'étais peu attentif...

 

It's not worth it ;)

French is not always easy to understand

 

@+

[(gile)]

Salut,

 

Tout d'abord bravo à ceux qui répondu, ça fonctionne.

 

Ensuite, j'avais effectivement oublié de préciser qu'il s'agissait se parcourir la table des blocs. L'idée de cette routine vient de ce sujet dans lequel il est question d'essayer de déterminer le nombre de fois qu'il faut purger un dessin pour être sûr d'avoir tout purgé (à ceci près que si le bloc le plus profondément imbriqué est purgeable et qu'il est le seul à utiliser un calque qui lui même est le seul à utiliser un type de ligne particulier, il manque encore 2purges à faire...)

 

Pour finir, je donne ma solution avant que le "king" Evgeniy ne dégaine.

Comme toutes, elle utilise la récursivité (je vois mal comment faire autrement avec des imbrications) et elle utilise aussi un "effet de bord" sur la variable deepest qui est locale pour la fonction principale, mais globale pour la sous fonction récursive.

 

(defun DeepestLevel (/ foo blocks deepest name)
 (vl-load-com)

 (defun foo (name cnt)
   (setq deepest (max deepest cnt))
   (vlax-for obj (vla-Item blocks name)
     (if (= (vla-get-ObjectName obj) "AcDbBlockReference")
       (foo (setq name (vla-get-EffectiveName obj)) (1+ cnt))
     )
   )
 )

 (setq blocks  (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
       deepest 1
 )
 (vlax-for blk blocks
   (if (and
         (= (vla-get-IsLayout blk) :vlax-false)
         (= (vla-get-IsXref blk) :vlax-false)
         (not (wcmatch (setq name (vla-get-Name blk)) "`**,*|*"))
       )
     (foo name 1)
   )
 )
 deepest
)

 

Et une version un tout petit peu moins concise mais qui ne retraite pas les blocs déjà traités.

(defun DeepestLevel (/ foo blocks deepest name bnames)
 (vl-load-com)

 (defun foo (name cnt)
   (setq deepest (max deepest cnt))
   (vlax-for obj (vla-Item blocks name)
     (if (= (vla-get-ObjectName obj) "AcDbBlockReference")
       (progn
         (foo (setq name (vla-get-EffectiveName obj)) (1+ cnt))
         (setq bnames (vl-remove name bnames))
       )
     )
   )
 )

 (setq blocks  (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
       deepest 1
 )
 (vlax-for blk blocks
   (if (and
         (= (vla-get-IsLayout blk) :vlax-false)
         (= (vla-get-IsXref blk) :vlax-false)
         (not (wcmatch (setq name (vla-get-Name blk)) "`*T*,`*D*,*|*"))
       )
     (setq bnames (cons name bnames))
   )
 )
 (while bnames
   (foo (car bnames) 1)
   (setq bnames (cdr bnames))
 )
 deepest
)

[Patrick_35]

Salut

 

(gile) :

Une petite amélioration possible dans ton lisp pour éviter un not en utilisant un or à la place du and et donc inverser la logique pour le test sur les onglets et les xrefs.

On peut aussi éviter le if grâce au and (ou or si le not est supprimé)

C'est juste histoire de gratter quelques millisecondes ;)

 

On peut aussi rebondir sur ce challenge pour dénombrer le nombre de bloc A, le nombre de B, etc...

Notre King (ElpanovEvgeniy) va pouvoir se creuser un peu plus les méninges ;)

 

Pour la purge, on peux faire un truc très simple

(repeat 10
 (vla-purgeall (vla-get-activedocument (vlax-get-acad-object)))
)

S'il y a + de 10 imbrications, c'est que le dessin est complexe.

 

@+

[bseb67]

Bon, je ne sais pas si (gile) a eu mon mp,

 

donc ma première version du code est disponible ici :

http://bseb67.free.fr/cadxp/challenge/30/challenge30.lsp

 

edit:

j'ai mis un fichier assez léger avec une profondeur de 65:

http://bseb67.free.fr/cadxp/challenge/30/Challenge30-sbs-65.dwg

 

pour le faire, c'est un petit lisp à ma sauce qui créer des blocs bidons avec

un certain nombre d'entités (hors blocs) et un certain autre nombre de blocs

et ainsi de suite jusqu'à n'avoir qu'un seul bloc.

 

[Edité le 2/12/2009 par bseb67]

[ElpanovEvgeniy]

Salut

 

Vous estimez est trop haut mes possibilités!

Vous avez écrit les programmes excellents, avec l'utilisation VLA-*

Pour moi resta seulement propre LISP...

 

(defun f (/ B I)
(defun f1 (a)
 (cond ((not a) 1)
       ((/= (cdr (assoc 0 (entget a))) "INSERT") (f1 (entnext a)))
       ((max (1+ (f1 (tblobjname "BLOCK" (cdr (assoc 2 (entget a)))))) (f1 (entnext a))))
 )
)
(setq i 0)
(while (setq b (cdr (assoc 2 (tblnext "BLOCK" (= 0 i)))))
 (setq i (max i (f1 (tblobjname "BLOCK" b))))
)
)

[(gile)]

Very nice, evgeniy :o :D

 

bseb67,

Il semble qu'il y ait un problème avec profondeur_maxi_des_blocs : il retourne ("VMNVOMVZVUWO" . 1) avec le fichier que tu as mis en ligne.

[bseb67]

euh... bizarre, car je viens d'ouvrir le fichier et de relancer mon lisp :

Commande: (profondeur_maxi_des_blocs)

("VMNVOMVZVUWO" . 65)

 

comme j'ai une 2008 et une 2010 sur mon poste et que j'utilise que la 2008,

j'ai testé avec la 2010 aussi... et j'ai le même résultat que toi :o ("VMNVOMVZVUWO" . 1)

 

Va falloir que je trouve pourquoi :casstet:

 

edit:

c'est tout con :cool: : il manquait (setq VAR_ACAD_DEF_BLOC "AcDbBlockReference")

au début du lisp, car dans la version 2008, je charge au démarrage un fichier lisp

contenant des fonctions que j'utilise souvent ainsi que des variables globales

 

J'ai mis à jour le fichier lisp sur mes pages perso et c'ets bon maintenant ;)

 

[Edité le 2/12/2009 par bseb67]

[Patrick_35]

Salut

 

Vous estimez est trop haut mes possibilités!

heu non, juste où se trouve le talent.

 

@+

[(gile)]

C'est marrant de comparer les différentes façon d'écrire : la différence entre l'hyper concision d'Evgeniy et le code très abondamment commenté de bseb67...

 

Un petit benchmark pour le fun :

avec le fichier que j'ai donné (niveau 4)

(benchmark '((lvl) (profondeur nil) (f) (profondeur_maxi_des_blocs) (DeepestLevel)))

Benchmarking ............Elapsed milliseconds / relative speed for 512 iteration(s):

 

(F).............................1219 / 3.22

(PROFONDEUR nil)................1500 / 2.61

(DEEPESTLEVEL)..................1531 / 2.56

(PROFONDEUR_MAXI_DES_BLOCS).....2234 / 1.76

(LVL)...........................3922 / 1

 

avec le fichier de bseb67 (niveau 65)

(benchmark '((lvl) (profondeur nil) (f) (profondeur_maxi_des_blocs) (DeepestLevel)))

Benchmarking .........Elapsed milliseconds / relative speed for 64 iteration(s):

 

(DEEPESTLEVEL)...................1844 / 13.29

(PROFONDEUR_MAXI_DES_BLOCS)......2703 / 9.06

(LVL)............................6297 / 3.89

(F).............................17937 / 1.37

(PROFONDEUR nil)................24500 / 1

[zebulon_]

Bonjour,

 

(tblnext "BLOCK" (= 0 i)) 

bien sûr... plutôt que de faire exprès un (tblnext "BLOCK" T) juste pour le premier.

 

On en apprend tous les jours. Vous me direz : "c'est le but de ces challenges !"

 

A la course au benchmark, je suis 2ème :) ou dernier :(, suivant le niveau d'imbrication. Mais j'étais déjà content que ça marche. Si en plus ça marche vite, c'est pas exprès.

 

Merci

Amicalement

Vincent

 

 

[(gile)]

ou encore :

(while (setq blk (tblnext "BLOCK" (not blk))) ...)

[bseb67]

Bon, ca va, je ne m'en sors pas si mal :)

4/5 avec fichier simple

2/5 avec fichier profond

 

soit 3.5/5, car on a plus souvent une profondeur de 3-8 que de 65 :cool:

[Patrick_35]

Salut

 

Dernier :(

 

Mais comme je n'étais pas parti dans le sens de ne compter que le niveau d'imbrication, mais de savoir ce que contenais le bloc avec ses sous-blocs ;)

 

ps : bseb67, pourquoi donner le lisp à l'origine par mp et ne pas le mettre directement ?

 

@+

[bseb67]

Salut

 

Dernier :(

 

Mais comme je n'étais pas parti dans le sens de ne compter que le niveau d'imbrication, mais de savoir ce que contenais le bloc avec ses sous-blocs ;)

 

Moi je trouve ca super pratique quand même :D

HS: ca rejoint un peu le fichier xml que je génère

comme par exemple ici :

http://bseb67.free.fr/cadxp/challenge/30/test.xml

 

ps : bseb67, pourquoi donner le lisp à l'origine par mp et ne pas le mettre directement ?

 

en fait, j'avais envoyé un mp assez rapidement, avec le lien, du fait que je voulais

laisser du temps aux autres. ;)

[ElpanovEvgeniy]

C'est marrant de comparer les différentes façon d'écrire : la différence entre l'hyper concision d'Evgeniy et le code très abondamment commenté de bseb67...

 

Vous avez choisi la vitesse... :)

 

Ma réponse :

(defun ff4 (/ A B C D E F)
;;(ff4)
(defun rd (l)
 (if l
  (cons (car l) (rd (vl-remove (car l) (cdr l))))
 ) ;_  if
) ;_  defun
(while (setq b (cdr (assoc 2 (tblnext "BLOCK" (not b)))))
 (setq a (tblobjname "BLOCK" b))
 (while a
  (while (and a (/= (cdr (assoc 0 (entget a))) "INSERT")) (setq a (entnext a)))
  (setq c (cons (cons b a) c))
  (and a (setq a (entnext a)))
 ) ;_  while
) ;_  while
(foreach a c
 (setq f (cons (if (cdr a)
                (list (cdr (assoc 2 (entget (cdr a)))) (car a))
               ) ;_  if
               f
         ) ;_  cons
 ) ;_  setq
) ;_  foreach
(setq f (vl-remove nil f)
      c (mapcar (function reverse) f)
      d 1
      e 1
) ;_  setq
(foreach a (vl-remove-if (function (lambda (a) (assoc a f)))
                         (rd (mapcar (function car) c))
           ) ;_  vl-remove-if
 (while (setq a (assoc a c))
  (setq d (1+ d)
        c (vl-remove a c)
        a (cadr a)
  ) ;_  setq
 ) ;_  while
 (setq e (max d e)
       d 1
 ) ;_  setq
) ;_  foreach
e
)

 

 

Un petit benchmark pour le fun :

avec le fichier que (gile) donn? (niveau 4)

_$

Benchmarking ............Elapsed milliseconds / relative speed for 512 iteration(s):

 

(FF4)..............1047 / 2.7

(DEEPESTLEVEL).....2828 / 1

 

 

_$

 

 

avec le fichier de bseb67 (niveau 65)

_$

Benchmarking .........Elapsed milliseconds / relative speed for 64 iteration(s):

 

(FF4)..............1766 / 1.9

(DEEPESTLEVEL).....3360 / 1

 

 

_$

[ElpanovEvgeniy]

Un petit benchmark pour le fun :

avec le fichier que (gile) donn? (niveau 4)

_$

Benchmarking ............Elapsed milliseconds / relative speed for 512 iteration(s):

 

(FF4)................1078 / 2.62

(PROFONDEUR nil).....2750 / 1.03

(DEEPESTLEVEL).......2828 / 1

 

 

_$

 

 

avec le fichier de bseb67 (niveau 65)

_$

Benchmarking .........Elapsed milliseconds / relative speed for 64 iteration(s):

 

(FF4).................1797 / 26.4

(DEEPESTLEVEL)........3344 / 14.19

(PROFONDEUR nil).....47438 / 1

 

 

_$

 

[Edité le 3/12/2009 par ElpanovEvgeniy]

[(gile)]

You're THE KING, Evgeniy !

 

Ce que racontent en premier lieu ces benchmaks, c'est que globalement ces toutes routines sont plutôt lentes :

entre 1.2 et 3.9 secondes pour 512 itérations avec un niveau 4 et entre 1.8 et 24.5 seconde pour 64 itération avec un niveau 65.

 

Ensuite, pour les classements, tout est très relatif, et dépend de ce que fait la routine et de jusqu'où on veut bien aller dans l'optimisation.

Personnellement, entre les deux routines d'Evgeniy, la concision et la pureté du code de la première m'émeut beaucoup plus que que les quelques millisecondes gagnées avec la seconde.