Challenge 16

[Bred]

Matt666 :

Pour moi la récursivité (pour cette fonction, eb tout cas), c'est comme un train :

il commence par un wagon, si ça l'intéresse, il continue en gradant le wagon. S'il c'est le cas contraire, il supprime le wagon.

Je penses que ce que tu expliques est plutôt une image des fonctions foreach, ou mapcar avec vl-remove**

Pour traiter une liste "wagon par wagon" c'est une méthode évidente pour traiter une liste (malgré que ma fonction récursive ne passe pas en revue tous les éléments de la liste mais "saute" de clef 10 en clef 10....

 

(gile) : merci, j'ai l'impression que tu expliques en mieux ce que j'essayais de faire comprendre !

Je suis content et je te remercie (encore) : si je commence à y comprendre quelque chose c'est bien grâce aux différentes explication des liens cités plus haut !

 

[Edité le 11/12/2007 par Bred]

[zebulon_]

Bonjour,

 

J'aime bien la commande (assoc key aliste) qui recherche key comme élément clé dans la liste d'association et retourne l'entrée de aliste. Aussi, il me semblait opportun de faire une fonction équivalente pour le cas ou la liste ne comporterait pas un article clé, mais plusieurs.

Donc une fonction (massoc key aliste), par exemple. Le m pour "multiple", vous vous en êtes douté.

 

Cela pourrait ressembler à quelque chose comme ça

 

(defun massoc (key alist / x nlist)
 (setq nlist nil)
 (foreach x alist
   (if (eq key (car x))
     (setq nlist (cons (cdr x) nlist))
   )
 )
 (reverse nlist)
)

 

Commande: (setq e (car (entsel)))

 

Choix de l'objet:

 

Commande: (setq a (entget e))

((-1 . ) (0 . "LWPOLYLINE") (330 .

7ef93cf8>) (5 . "117") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")

(100 . "AcDbPolyline") (90 . 6) (70 . 0) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10

605.683 723.607) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 970.653 1284.19) (40 .

0.0) (41 . 0.0) (42 . 0.0) (10 1745.1 943.837) (40 . 0.0) (41 . 0.0) (42 . 0.0)

(10 1400.16 463.335) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 959.525 906.019) (40

. 0.0) (41 . 0.0) (42 . 0.0) (10 705.827 421.068) (40 . 0.0) (41 . 0.0) (42 .

0.0) (210 0.0 0.0 1.0))

 

Commande: (massoc 10 a)

((605.683 723.607) (970.653 1284.19) (1745.1 943.837) (1400.16 463.335)

(959.525 906.019) (705.827 421.068))

 

Avec la possibilité de paramétrer la clé.

 

Amicalement

Zebulon_

 

[(gile)]

Bred,

ma fonction récursive ne passe pas en revue tous les éléments de la liste mais "saute" de clef 10 en clef 10

Pas vraiment, assoc doit bien parcourrir la liste jusqu'au premier (10 ...) trouvé et vl-remove parcourt toute la liste à la recheche de toutes les occurences.

 

_$ (benchmark '((coord-recurs lst20) (bred4 lst20)))

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

 

(COORD-RECURS LST20).....1219 / 1.90

(BRED4 LST20)............2312 / 1.00

_$ (benchmark '((coord-recurs lst100) (bred4 lst100)))

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

 

(COORD-RECURS LST100)......1125 / 9.08

(BRED4 LST100)............10219 / 1.00

 

 

zebulon_,

 

C'est ce que je voulais dire avec dxf-grpe, on peut adapter chacune des routines qui ont été données plus haut.

 

 

Pour le nouveau challenge (retourner la liste des longueurs de chaque segment),

pour ceux qui ne savent pas à quoi correspond le bulge (la courbure) d'un segment de polyligne,

pour ceux qui ont du mal en anglais avec le lien donné par zebulon_,

 

La valeur du code de groupe DXF 42 des polylignes correspond à la tangente du quart de l'angle de l'arc, autrement dit à la longueur de la flèche divisée par la moité de la corde.

Cette valeur est positive quand l'arc (par rapport à l'ordre des sommets) est dans le sens trigonométrique, négative si l'arc est dans le sens horaire.

Elle est égale à 0.0 pour les segments droits à 1 (ou -1) pour les demi cercles.

 

La longueur d'un arc est égale à l'angle de l'arc (en radians) multiplié par le rayon.

 

http://img212.imageshack.us/img212/3293/arcdw7.png

 

 

[Edité le 11/12/2007 par (gile)]

[Bred]

Salut Zebulon,

on peut en effet faire ce que tu dits, et c'est d'aileur la finalité je pense de ce challenge.

Personnellement j'utilise cette routine :

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; (lst-assoc 10 ent-lwpolyligne) -> tous les sommets de la lwpolyligne;
(defun lst-assoc (cle lst)
 (mapcar 'cdr (vl-remove-if '(lambda (x) (not(equal(car x) cle))) lst))
)

 

Edit : Je viens de réaliser un Echo à (gile)....

 

Ok, gile, il est vrais que assoc doit certainement passer en revue la liste (c'est bien lent d'ailleurs... :casstet:)

 

[Edité le 11/12/2007 par Bred]

[zebulon_]

zebulon_,

 

C'est ce que je voulais dire avec dxf-grpe, on peut adapter chacune des routines qui ont été données plus haut.

 

Pardon, je n'avais pas tout lu en détail. Mais je trouve que le nom (massoc ...) est plus facile à retenir pour de vieux lispeurs, élevés à coup de (assoc ...)

 

Amicalement

Zebulon_

 

[Matt666]

Sous quelle forme doit-on retourner la liste des longueurs ?

[(gile)]

Sous quelle forme doit-on retourner la liste des longueurs ?

 

La réponse est dans la question : une liste (long_segm_1 long_segem_2 long_segm_1 ... long_segm_n)

 

Exemple (la fonction à trouver s'appelle ici seg-lst) :

 

(command "_.pline" "_non" '(0 0) "_non" '(5 0) "_non" '(5 3) "_non" '(3 3) "")

(setq elst (entget (entlast)))

 

(seg-lst elst) -> (5.0 3.0 2.0)

 

Avec un arc :

 

(command "_.pline" "_non" '(0 0) "_non" '(5 0) "_a" "_non" '(5 3) "_li" "_non" '(3 3) "")

(setq elst (entget (entlast)))

 

(seg-lst elst) -> (5.0 4.71239 2.0)

 

EDIT : si la polyligne est fermée :

 

(command "_.pline" "_non" '(0 0) "_non" '(5 0) "_a" "_non" '(5 3) "_li" "_non" '(3 3) "_c")

(setq elst (entget (entlast)))

 

(seg-lst elst) -> (5.0 4.71239 2.0 4.24264)

 

 

[Edité le 12/12/2007 par (gile)]

[Matt666]

un truc comme ça ?

(defun test (lst / a r l)
   (setq lst (splist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (member (car x) '(10 42))) lst))))
   (foreach pt lst
       (if (/= (cadr pt) 0)
           (setq 
               a (* 4.0 (atan (abs (cadr pt))))
               r (/ (distance (car pt) (caddr pt)) (sin a))
               l (cons (* a r) l)
           )
           (setq l (cons (distance (car pt) (caddr pt)) l))
       )
   )
   (reverse l)
)

(defun splist (lst / ls)
   (while (and (car lst) (cadr lst) (caddr lst))
       (setq ls (cons (list (car lst) (cadr lst) (caddr lst)) ls ))
       (setq lst (cddr lst))
   )
   (reverse ls)
)

 

ya un pb.... Pour les arcs négatifs... grmbl

 

[Edité le 12/12/2007 par Matt666]

[(gile)]

C'est un bon début Matt, mais les résultats sur les arcs sont faux, et le dernier segment des polylignes fermées n'est pas pris en compte.

 

Essaye avec :

(command "_.pline" "_non" '(0 0) "_non" '(1 0) "_a" "_non" '(1 2) "_li" "_non" '(1 1) "")

(setq elst (entget (entlast)))

 

(test elst) devrait retourner : (1.0 3.14159 1.0)

 

et avec :

(command "_.pline" "_non" '(0 0) "_non" '(1 0) "_a" "_non" '(1 2) "_li" "_non" '(1 1) "_c")

(setq elst (entget (entlast)))

 

(test elst) devrait retourner : (1.0 3.14159 1.0 1.41421)

[Matt666]

Bon ben là je crois que c'est bon ! :D

 

(defun lg-matt (lst / a r p l)
   (if (eq (cdr (assoc 70 lst)) 1)
       (setq lst (splist (mapcar 'cdr (remove-if-not '(lambda (x) (member (car x) '(10 42))) lst)) 1))
       (setq lst (splist (mapcar 'cdr (remove-if-not '(lambda (x) (member (car x) '(10 42))) lst)) nil))
   )
   (foreach pt lst
       (setq p (cadr pt))
       (if (/= p 0.00)
           (progn
               (setq 
                   a (* 4.0 (atan (abs p)))
                   r (/ (/ (distance (car pt) (caddr pt)) 2) (sin (/ a 2)))
                   l (cons (* a r) l)
               )
           )
           (setq l (cons (distance (car pt) (caddr pt)) l))
           
       )
   )
   (reverse l)
)

(defun splist (lst n / ls)
   (while (and (car lst) (cadr lst) (caddr lst))
       (setq ls (cons (list (car lst) (cadr lst) (caddr lst)) ls))
       (setq lst (cddr lst))
   )
   (if n
       (reverse (cons (list (caddar ls)(last lst)(car (last ls))) ls))
       (reverse ls)
   )
)

 

Dur, quand même...

[Matt666]

Et je sens qu'y en un qui va me balancer un code trois fois plus beau et concis...

 

 

 

 

 

 

 

 

 

 

 

 

Sniff..

[(gile)]

Super ça marche :)

Juste un truc concernant le test pour voir si la polyligne est fermée :

si la variable PLINEGEN est à 1 on a (70 . 129) pour une polyligne fermée, elle passera au travers de ton test.

Regarde la fonction logand ou Boole.

À part ça, tu peux essayer de simplifier certaines expressions (et formule) pour rendre ton code plus concis et peut-être plus performant.

[Patrick_35]

Bonjour

 

Et bien, voici un challenge que j'ai raté, mais qui a bien fonctionné apparement. :)

Je constate que se sont ceux d'un certain niveau qui ont beaucoup participé.

Faut-il en déduire qu'il faut toujours que cela soit dur pour avoir des participations ?

 

@+

[Matt666]

Salut Patrick_35 !

Faut-il en déduire qu'il faut toujours que cela soit dur pour avoir des participations ?

En fin de compte le 1er challenge n'était pas très dur... Et qqns ont participé. Par contre la fin était plus ardue (récursivité et longueur d'une pline), et peu d'entre nous ont participé.

 

C'est dommage, ces challenges paraissent réservés aux habitués/ à ceux qui touchent plutot bien, même si c'est n'est pas l'intention première.

 

Pourtant le nombre de lectures est assez fort. Ces challenges intéressent les utilisateurs de ce site...

 

Je vais tenter de proposer un challenge pour débutant extrème (!!), voir s'il recueille plus de participation.

Par exemple retourner le nom du calque d'une entité sélectionnée...

 

C'est dommage, je trouve ça vraiment très enrichissant !!

 

Allez je vais le poster...

 

A bientot !

Matt.

[(gile)]

Il n'y a pas d'autres réponses pour la liste des longuers de segment ?...

 

Ce soir je postrai quelques exemples.

[Matt666]

Je suis en train d'en préparer une itérative sans la routine splist... Donc plus courte et améliorée.

mais c'est pas évident...

[(gile)]

Proche de la méthode utilisée par Matt cette version utilise une liste du type (p1 b1 p2 b2 p3 b3 ... pn bn) -ou (p1 b1 p2 b2 p3 b3 ... pn bn p1) si la poly est fermée-.

La fonction boucle tant que la liste contient au moins 3 éléments.

A chaque itération elle traite les 3 premiers éléments puis reboucle sur la liste moins les 2 premiers.

 

(defun gile1 (elst / cl lst ret)
 (setq cl (logand 1 (cdr (assoc 70 elst))))
 (while elst
   (if	(member (caar elst) '(10 42))
     (setq lst (cons (cdar elst) lst))
   )
   (setq elst (cdr elst))
 )
 (if (zerop cl)
   (setq lst (reverse lst))
   (setq lst (reverse (cons (last lst) lst)))
 )
 (while (cddr lst)
   (setq ret (cons
	(cond
	  ((zerop (cadr lst)) (distance (car lst) (caddr lst)))
	  (T
	    ((lambda (ang)
	       (* (/ (distance (car lst) (caddr lst)) (sin ang)) ang)
	     )
	      (* 2 (atan (cadr lst)))
	    )
	  )
	)
	ret
      )
  lst (cddr lst)
   )
 )
 (reverse ret)
)

 

 

Dans cette version, 3 listes sont passées comme arguments à une expression mapcar,

(b1 b2 b3 b4 b5)

(p1 p2 p3 p4 p5)

(p2 p3 p4 p5) -ou (p2 p3 p4 p5 p1) si la poly est fermée-.

Les éléments de même rang de chaque liste sont traités ensembles pour donner un élément de la liste résultat.

 

(defun gile2 (elst / plst blst)
 (foreach p elst
   (cond
     ((= (car p) 10) (setq plst (cons (cdr p) plst)))
     ((= (car p) 42) (setq blst (cons (cdr p) blst)))
   )
 )
 (mapcar
   (function
     (lambda (bu p1 p2)
(cond
  ((zerop bu) (distance p1 p2))
  (T
   ((lambda (ang)
      (* (/ (distance p1 p2) (sin ang)) ang)
    )
     (* 2 (atan bu))
   )
  )
)
     )
   )
   (reverse blst)
   (reverse plst)
   (if	(= (logand 1 (cdr (assoc 70 elst))) 1)
     (cdr (reverse (cons (last plst) plst)))
     (cdr (reverse plst))
   )
 )
)

 

 

Plus rapide : le traitement direct de la liste entget.

Avec les fonctions member, assoc et cdr on peut passer directement de groupe 10 en groupe 10.

 

(defun gile3 (elst / cl next bulg ret)
 (setq	cl   (logand 1 (cdr (assoc 70 elst)))
elst (member (assoc 10 elst) elst)
 )
 (and (= 1 cl) (setq elst (append elst (list (car elst)))))
 (while (setq next (assoc 10 (cdr elst)))
   (setq bulg (cdr (assoc 42 elst))
  ret  (cons
	 (cond
	   ((zerop bulg) (distance (cdar elst) (cdr next)))
	   (T
	    ((lambda (ang)
	       (* (/ (distance (cdar elst) (cdr next)) (sin ang)) ang)
	     )
	      (* 2 (atan bulg))
	    )
	   )
	 )
	 ret
       )
  elst (member next elst)
   )
 )
 (reverse ret)
)

 

 

Un peu "bord limite", mais l'utilisation des fonctions vlax-curve permet un code concis et rapide.

Chaque 'Param' entier correspond à un sommet de la polyligne.

 

(defun gile4 (elst / pl pa d1 d2 ret)
 (vl-load-com)
 (setq	pl (cdr (assoc -1 elst))
pa (fix (vlax-curve-getEndParam pl))
d1 (vlax-curve-getDistAtParam pl pa)
 )
 (while (setq d2 (vlax-curve-getDistAtParam pl (setq pa (1- pa))))
   (setq ret (cons (- d1 d2) ret)
  d1  d2
   )
 )
 ret
)

[Matt666]

Bing.

Que dire après ça...

 

Bravo Gile !!! Impressionnant...