Challenge 12

[bseb67]

Resalut!

 

 

Oups :P , je suis tête en l'air, angle renvoi entre 0 et 2*Pi.

C'est ce qui arrive quand on fait ca le soir après une journée de travail,

de la musique en fond sonore et que l'on joue en même temps. ;)

Je ne suis pas une femme :cool:.

 

 

, donc petite correction:

((or (= (setq ang1 (abs (angle (nth (1- cpt) res) (nth cpt res))))
			(setq ang2 (abs (angle (nth cpt res) (nth (1+ cpt) res)))))
		     (= ang1 (+ Pi ang2))
		     (= ang2 (+ Pi ang1))
		 )

 

Donc avec lst:

(remove-align-bseb lst) => ((2031.72 887.831 0.0) (1103.09 444.369 0.0) (2479.32 281.238 0.0) (1242.68 -141.286 0.0) (1242.68 748.925 0.0))

 

 

[(gile)]

Salut,

 

Je ne comprends pas le pourquoi de ta modif, bseb, d'après mes tests, ta première version semble retourner les mêmes résultats que que celles de Bred ou les miennes (les dernières) à savoir ne pas supprimer de point dans la liste que tu donnes.

 

Donc, toutes les routines fonctionnent...

...en 2d.

 

Si on leur passe une liste du style ((1 2 0) (3 2 0) (5 2 2)) elles retounent ((1 2 0) (5 2 1)) au lieu de ((1 2 0) (3 2 0) (5 2 2))

 

 

Je propose donc une deuxième étape, un fonctionnement cohérent en 3d, exemple :

 

(remove-align-3d '((1 2 0) (2 2 0) (3 2 0) (4 2 1) (5 2 2))) -> ((1 2 0) (3 2 0) (5 2 2))

[Matt666]

Salut !!!

Merci pour cette très belle révision de l'énoncé Gile ! C'est vraiment plus clair maintenant...

 

Dément.. Je vois que ça marche toujours aussi fort (enfin pour les 3 personnes qui répondant !!)... Je n'avais pas pensé aux angles... j'étais encore à essayer de savoir si les 3 premiers points étaient alignés !!

Trop compliqué quoi..

 

Merci encore pour ces très beaux exemples de codes (eh oui un code peut être beau !!), je teste ça ce matin..

 

A bientot.

Matt.

[bseb67]

Salut (Gile)!

 

Je ne comprends pas le pourquoi de ta modif, bseb,

 

La modification corrige le test, car moi, comme un con, j'ai pas trop réfléchit au retour de (angle).

Car j'avais essayé la première version avec mon exemple lst, et bien ca marchait pas.

 

Maintenant, pour la 3D, je vais partir sur trois choses: distance par rapport '(0.0 0.0 0.0), angle plan (angle normale), angle Z.

 

Pour matt, je ne parle jamais de beau code, mais plus tot de code clair, propre et/ou efficace ;).

 

 

[Bred]

Salut,

Pour les points 3D :

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 	Polar3D : coord point entre 2 point/distance			;
(defun polar3D (p1 p2 Lg)
(mapcar '(lambda (x1 x2) (+ (/ (* Lg (- x2 x1)) (distance p1 p2)) x1)) p1 p2)
)
(defun remove-align-3D (lst / lst-t)
 (setq lst-t lst)
 (mapcar '(lambda (x1) (if (> (length (member x1 lst)) 2)
		  (if (equal (polar3D x1 (cadr (member x1 lst)) (distance x1 (caddr (member x1 lst))))
			     (caddr (member x1 lst)))
		    (setq lst-t (vl-remove (cadr (member x1 lst)) lst-t))))) lst)
 lst-t
 )

 

... et ça fonctionne en 2D aussi....

 

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

[(gile)]

Super , Bred !

 

Juste un truc, dans polar3d, tu n'évalues pas si p1 et p2 sont confondus, si c'est le cas tu auras une Erreur: division par 0.

 

Moi aussi, je garde les mêmes, je change juste la condition, au lieu de comparer des angles, on compare des vecteurs unitaires.

 

Edit : Bseb67 a raison quand il parle de clarté d'un code, je sacrifie donc quelques microsecondes à la lisibilité en décomposant BETWEENP en 2 routines plus explicites

 

;;; VEC1 Retourne le vecteur normé (1 unité) de sens p1 p2

(defun vec1 (p1 p2 / d)
 (if (not (zerop (setq d (distance p1 p2))))
   (mapcar '(lambda (x1 x2) (/ (- x2 x1) d)) p1 p2)
 )
)

;; BETWEENP Evalue si pt est entre p1 et p2 (ou confondu avec)

(defun betweenp	(p1 p2 pt)
 (or (equal p1 pt 1e-9)
     (equal p2 pt 1e-9)
     (equal (vec1 p1 pt) (vec1 pt p2) 1e-9)
 )
) 

 

Et toujours les deux petites routines

 

(defun remove-align-3d-gile1 (lst)
 (if (cddr lst)
   (if	(betweenp (car lst) (caddr lst) (cadr lst))
     (remove-align-3d-gile1 (cons (car lst) (cddr lst)))
     (cons (car lst) (remove-align-3d-gile1 (cdr lst)))
   )
   lst
 )
) 

 

(defun remove-align-3d-gile2 (lst / rslt)
 (while (caddr lst)
   (if	(betweenp (car lst) (caddr lst) (cadr lst))
     (setq lst (cons (car lst) (cddr lst)))
     (setq rslt (cons (car lst) rslt)
    lst	 (cdr lst)
     )
   )
 )
 (append (reverse rslt) lst)
) 

 

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

[Bred]

uste un truc, dans polar3d, tu n'évalues pas si p1 et p2 sont confondus, si c'est le cas tu auras une Erreur: division par 0.

Ben tiens.... merci....

faut que je le corrige dans mes lisps perso, je n'avais jamais fait attention !!!

Correction :

(defun polar3D (p1 p2 Lg)
 (if (not (equal p1 p2))
   (mapcar '(lambda (x1 x2) (+ (/ (* Lg (- x2 x1)) (distance p1 p2)) x1)) p1 p2))
) 

(defun remove-align-3D (lst / lst-t)
 (setq lst-t lst)
 (mapcar '(lambda (x1) (if (> (length (member x1 lst)) 2)
		  (if (equal (polar3D x1 (cadr (member x1 lst)) (distance x1 (caddr (member x1 lst))))
			     (caddr (member x1 lst)))
		    (setq lst-t (vl-remove (cadr (member x1 lst)) lst-t))))) lst)
 lst-t
)

 

(gile)

J'ai du mal à comprendre tes routines :

Je ne vois pas comment en récupérant le vecteur normé de 2 points tu arrives à savoir si un troisième est au milieu...

(et en cherchant à comprendre j'ai remarqué que pour 2 points identiques, tu pourrais au lieu de faire (equal p1 pt 1e-9), faire (not (vec1 p1 pt)) ... )

 

 

 

[(gile)]

Petite correction.

 

Pour des test un peu plus poussés, j'ai fait une polyligne un peu vicieuse avec un sommet qui revient croiser sur un sommet précédent.

Et bien ça pose problème. Je pense que ça vient de l'utilisation de vl-remove.

 

Pour faire le test j'utilise ces deux expressions :

 

(setq lst (mapcar 'cdr
	  (vl-remove-if-not
	    '(lambda (x) (= (car x) 10))
	    (entget (entlast))
	  )
  )
)

(command "_.pline")
(mapcar 'command (remove-align-xxxx LST))
(command) 

 

en remplaçant xxxx par les différents pseudos dans la seconde.

 

Résultats 2d en image (la première routine de bred ne fonctionne pas : "; erreur: type d'argument incorrect: point 2D/3D: nil")

 

http://img442.imageshack.us/img442/2319/challenge123ly3.png

 

en 3d ,c'est pareil :

 

http://img69.imageshack.us/img69/6359/challenge124bp5.png

 

Petite explication sur l'utilisation des vecteurs :

 

- pour pouvoir les comparer (égalité), il faut d'abord les ramener à la même norme (unitaire). Ensuite on peut évaluer s'il la même direction et le même sens. Si le premier est construit de p1 à p2 et qu'il a le même sens que celui construit de p2 à p3, p2 est forcément entre p1 et p3

 

En haut les vecteurs on la même direction mais sont de sens opposés : ils ne sont pas égaux. En bas ils sont égaux, et p2 est donc bien entre p1 et p3

 

http://img231.imageshack.us/img231/4219/challenge125sa1.png

[Bred]

:mad: :casstet: :exclam: ...

Ben tu viens encore de me gacher la journée !....

Et dire que c'est toi qui m'a "forcé" à jouer........

[(gile)]

C'est bseb67 qui a commencé avec ses polylignes qui reviennent sur leur pas !

 

Avec des polylignes "normales", bien rangées quoi, qui ne se marchent pas dessus et dont tous les sommets se suivent à la queue-leu-leu, ma première réponse avec inters marchait très bien en 3d comme en 2d...

[bseb67]

C'est bseb67 qui a commencé avec ses polylignes qui reviennent sur leur pas !

 

Pouce :cool: !

 

Comme je suis un peu tordu d'esprit (l'air d'alsace est différent ;) ), et qu'en cours on nous martelle régulièrement: l'utilisateur peut faire n'importe quoi , écraser une mouche sur son clavier! :o :o

Il faut gérer un max.

 

Mais avec cela, on s'en sort plus. On fera comme microsoft: on gère plus ou moins et si ca marche pas, et bien c'est l'utilisateur qui a mal agi :cool: .

 

Pour la mise à jour de mon lisp, le week-end chargé qui m'attend risque de la mettre en attente.

 

Donc bon week-end à vous 3 en particulier et aux autres aussi. :D

[Matt666]

Exemple d'utilisation du code généré par ce challenge (bah oui faut bien quand même !) :

 

Optimisation de polyligne :

(defun c:OPL (/ CMDECHO CN DENT ENT LST N NLST SEL)
    (princ "\nSélectionner les polylignes à optimiser : ")
    (setq cmdecho (getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (if (setq sel (ssget))
         (progn
              (command "_UNDO" "D")
              (repeat (setq cn (sslength sel))
                   (setq 
                        ent  (ssname sel (setq cn (1- cn)))
                        dent (entget ent)
                        lst  (remove-doubles (remove-align (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
                        
                   )
                   (foreach pt (remove-all lst (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))
                        (setq n (vl-position pt dent))
                        (setq nlst 
                             (append 
                                  (sublist dent 0 n)
                                  (sublist dent (+ n 4) nil)
                             )
                        )
                        (setq dent nlst)
                   )
                   (entmod nlst)
                   (entupd ent)
                   (princ "\nPolyligne optimisée.")
              )
         )
    )
    (command "_UNDO" "F")
    (setvar "cmdecho" cmdecho)
    (princ)
)

;;; SUBLIST De GILE
(defun sublist (lst start leng / n r)
    (if (or   (not leng) 
              (< (- (length lst) start) leng)
         )
         (setq leng (- (length lst) start))
    )
    (setq n (+ start leng))
    (repeat leng
         (setq r (cons (nth (setq n (1- n)) lst) r))
    )
)

;;; REMOVE-ALIGN De GILE
(defun remove-align (lst / rslt)
    (while (caddr lst)
         (if (betweenp (car lst) (caddr lst) (cadr lst))
              (setq lst (cons (car lst) (cddr lst)))
              (setq rslt (cons (car lst) rslt)
                   lst (cdr lst)
              )
         )
    )
    (append (reverse rslt) lst)
)

;;; REMOVE-DOUBLES De GILE
(defun remove-doubles (lst)
    (if lst
         (cons (car lst) (remove-doubles (vl-remove (car lst) lst)))
    )
)

;;; REMOVE-ALL
;;; Supprime tous les éléments d'une liste à partir d'une autre
;;; (REMOVE-ALL '(1 3 5) '(1 2 3 4 5 6 7)) -> (2 4 6 7)
(defun REMOVE-ALL (lise lisc)
    (foreach pt lise (setq lisc (vl-remove pt lisc)))
)

;;; BETWEENP Evalue si pt est entre p1 et p2 (ou égal à)
;;;Lisp de GILE
(defun betweenp (p1 p2 pt)
    (or 
         (equal p1 pt 1e-9)
         (equal p2 pt 1e-9)
         (equal (vec1 p1 pt) (vec1 pt p2) 1e-9)
    )
)

;;; VEC1 Retourne le vecteur normé (1 unité) de p1 à p2 (nil si p1 = p2)
;;;Lisp de GILE
(defun vec1 (p1 p2)
    (if (not (equal p1 p2 1e-009))
         (mapcar '(lambda (x1 x2)
                   (/ (- x2 x1) (distance p1 p2))
              )
              p1
              p2
         )
    )
)

 

Voilà. Bon je sais mon code n'est pas des plus concis, et puis comme d'habitude, je n'ai pas du prendre en compte tous les cas de figures !

 

A bientot !

Matt.

 

PS : Merci encore à vous pour ces très belles (je reste sur ma position de code "beau" bseb67 ;) ) routines qui nous font apprendre un peu plus ce langage !

 

[Edité le 15/10/2007 par Matt666]