challenge 8 (ou le jeu des dominos)

Didier-AD · le 24 mai 2007

une idée de challenge un peu plus qu'intermédiaire pour les fanas des gestions de listes

Elle me vient du problème posé par BonusCAD concernant la projection d'une polyligne 2D sur un modèle de terrain à facettes

Soit une série de doublets de points correpondant à des segments de polyligne 3D à construire

((P1 P2) (P5 P6) (P9 P10) (P2 P3) (P7 P8) (P4 P5) (P6 P7).(P3 P4)......)

il s'agit de les remettre dans l'ordre en faisant correspondre les débuts de doublet et les extrèmités

(P1 P2) (P2 P3) (P3 P4) (P4 P5) (P6 P7) (P7 P8) (P8 P9) (P9 P10)......

dans un premier temps on pourra considérer que les doublets ne sont pas à inverser; dans un second temps on pourra imaginer avoir récupéré aussi bien (P5 P6) que (P6 P5)

exemple

(Sortlist '(((3.0 4.0 0.0) (3.0 6.0 0.0)) ((1.0 2.0 0.0) (1.0 4.0 0.0))

((1.0 4.0 0.0) (3.0 4.0 0.0)) ((3.0 6.0 0.0) (4.0 7.0 0.0))

((6.0 7.0 0.0) (6.0 4.0 0.0)) ((6.0 4.0 0.0) (7.0 3.0 0.0))

((4.0 7.0 0.0) (6.0 7.0 0.0)) ((7.0 3.0 0.0) (9.0 3.0 0.0))

((9.0 3.0 0.0) (10.0 5.0 0.0)) ((12.0 5.0 0.0) (12.0 3.0 0.0))

((10.0 5.0 0.0) (12.0 5.0 0.0))

))

donne

(((1.0 2.0 0.0) (1.0 4.0 0.0)) ((1.0 4.0 0.0) (3.0 4.0 0.0))

((3.0 4.0 0.0) (3.0 6.0 0.0)) ((3.0 6.0 0.0) (4.0 7.0 0.0))

((4.0 7.0 0.0) (6.0 7.0 0.0)) ((6.0 7.0 0.0) (6.0 4.0 0.0))

((6.0 4.0 0.0) (7.0 3.0 0.0)) ((7.0 3.0 0.0) (9.0 3.0 0.0))

((9.0 3.0 0.0) (10.0 5.0 0.0)) ((10.0 5.0 0.0) (12.0 5.0 0.0))

((12.0 5.0 0.0) (12.0 3.0 0.0)))

ce sont des points 2D mais çà doit marcher aussi avec les points 3D

PS, je n'ai pas encore cherché donc je n'ai pas encore de solution

Ps2 : Après réflexion, En fait, c'est assez simple...

[Edité le 24/5/2007 par Didier-AD]

Patrick_35 · le 25 mai 2007

Salut

Ce soir pour la réponse, ou il faut attendre un peu plus ?

@+

ElpanovEvgeniy · le 25 mai 2007

Salut
Ce soir pour la réponse, ou il faut attendre un peu plus ?

@+

J'occupe le tour, après toi.

(gile) · le 25 mai 2007

J'avais fait quelque chose d'assez similaire avec les listes de coordonnées de plusieurs entités (lignes, polylignes) qui retournait en une seule liste les coordonnées de la polyligne résultant de la jonction de ces entités (si elles sont jointives).

Ce que j'ai fait n'est pas très élégant, j'attends donc les réponses...

Patrick_35 · le 25 mai 2007

Merci ElpanovEvgeniy

Donc je tire le premier ;)

(defun Sortlist (lst)
 (vl-sort lst '(lambda (a b) (if (eq (caar a) (caar b))
			(< (cadar a) (cadar b))
			(< (caar a) (caar b))
		      )
	)
 )
)

(Sortlist '(((3.0 4.0 0.0) (3.0 6.0 0.0)) ((1.0 2.0 0.0) (1.0 4.0 0.0))

((1.0 4.0 0.0) (3.0 4.0 0.0)) ((3.0 6.0 0.0) (4.0 7.0 0.0))

((6.0 7.0 0.0) (6.0 4.0 0.0)) ((6.0 4.0 0.0) (7.0 3.0 0.0))

((4.0 7.0 0.0) (6.0 7.0 0.0)) ((7.0 3.0 0.0) (9.0 3.0 0.0))

((9.0 3.0 0.0) (10.0 5.0 0.0)) ((12.0 5.0 0.0) (12.0 3.0 0.0))

((10.0 5.0 0.0) (12.0 5.0 0.0))

))

Retourne

(((1.0 2.0 0.0) (1.0 4.0 0.0)) ((1.0 4.0 0.0) (3.0 4.0 0.0))

((3.0 4.0 0.0) (3.0 6.0 0.0)) ((3.0 6.0 0.0) (4.0 7.0 0.0))

((4.0 7.0 0.0) (6.0 7.0 0.0)) ((6.0 4.0 0.0) (7.0 3.0 0.0))

((6.0 7.0 0.0) (6.0 4.0 0.0)) ((7.0 3.0 0.0) (9.0 3.0 0.0))

((9.0 3.0 0.0) (10.0 5.0 0.0)) ((10.0 5.0 0.0) (12.0 5.0 0.0))

((12.0 5.0 0.0) (12.0 3.0 0.0)))

@+

ps : quelques fonctions mal expliqué dans l'aide

car + car = caar

car + cadr = cadar

car + caddr = caddar

car + cadr = caddr

cadr + cadr = cadadr

(gile) · le 25 mai 2007

Très joli, Patrick :)

De mon côté j'ai cherché avec l'inversion possible des doublets (et aussi en écartant les eventuels doublets qui ne se raccorderaient pas), donc, j'attends encore un peu pour poster.

avec la liste :

(setq lst2

'(((3.0 4.0 0.0) (3.0 6.0 0.0))

((1.0 2.0 0.0) (1.0 4.0 0.0))

((6.0 4.0 0.0) (7.0 3.0 0.0))

((4.0 7.0 0.0) (6.0 7.0 0.0))

((3.0 4.0 0.0) (1.0 4.0 0.0))

((4.0 7.0 0.0) (3.0 6.0 0.0)))

)

le résultat serait :

(((1.0 2.0 0.0) (1.0 4.0 0.0))

((1.0 4.0 0.0) (3.0 4.0 0.0))

((3.0 4.0 0.0) (3.0 6.0 0.0))

((3.0 6.0 0.0) (4.0 7.0 0.0))

((4.0 7.0 0.0) (6.0 7.0 0.0)))

Didier-AD · le 25 mai 2007

Bravo Patrick,

Sans inversion des doublets, je crois qu'on ne peut pas faire plus concis.

mais çà ne marche pas avec des doublets qui forment un contour fermé

essaie avec la liste suivante, tu verras.

(setq lz '(((3.0 4.0 0.0) (3.0 6.0 0.0)) ((1.0 2.0 0.0) (1.0 4.0 0.0))

((1.0 4.0 0.0) (3.0 4.0 0.0)) ((3.0 6.0 0.0) (4.0 7.0 0.0))

((6.0 7.0 0.0) (6.0 4.0 0.0)) ((6.0 4.0 0.0) (7.0 3.0 0.0))

((12.0 3.0 0.0) (1.0 2.0 0.0)) ;;;segment ajouté pour fermer le contour

((4.0 7.0 0.0) (6.0 7.0 0.0)) ((7.0 3.0 0.0) (9.0 3.0 0.0))

((9.0 3.0 0.0) (10.0 5.0 0.0)) ((12.0 5.0 0.0) (12.0 3.0 0.0))

((10.0 5.0 0.0) (12.0 5.0 0.0))

))

[Edité le 25/5/2007 par Didier-AD]

(gile) · le 26 mai 2007

Salut,

Une solution inspirée de ce que j'avais fait dans Join3dPoly, elle semble bien fonctionner avec possibilité d'inversion des doublets et contour fermé.

De plus elle devrait fonctionner aussi quelques soient les longueurs des listes de points à trier (doublets, triplets ou plus) et écarter les listes qui ne se raccordent pas

(defun Sortlist	(lst / domino tmp rslt)

 (defun domino	(pt fun lst)
   (car (vl-member-if
   '(lambda (l) (equal pt (fun l) 1e-9))
   lst
 )
   )
 )

 (setq	rslt (list (car lst))
lst  (cdr lst)
 )
 (while
   (or
     (and
(setq tmp (domino (caar rslt) car lst))
(setq rslt (cons (reverse tmp) rslt))
     )
     (and
(setq tmp (domino (caar rslt) last lst))
(setq rslt (cons tmp rslt))
     )
     (and
(setq tmp (domino (last (last rslt)) car lst))
(setq rslt (append rslt (list tmp)))
     )
     (and
(setq tmp (domino (last (last rslt)) last lst))
(setq rslt (append rslt (list (reverse tmp)))
)
     )
   )
    (setq lst (vl-remove tmp lst))
 )
 rslt
)

Avec les listes données plus haut :

(sortlist lz) ->

(((3.0 6.0 0.0) (4.0 7.0 0.0))

((4.0 7.0 0.0) (6.0 7.0 0.0))

((6.0 7.0 0.0) (6.0 4.0 0.0))

((6.0 4.0 0.0) (7.0 3.0 0.0))

((7.0 3.0 0.0) (9.0 3.0 0.0))

((9.0 3.0 0.0) (10.0 5.0 0.0))

((10.0 5.0 0.0) (12.0 5.0 0.0))

((12.0 5.0 0.0) (12.0 3.0 0.0))

((12.0 3.0 0.0) (1.0 2.0 0.0))

((1.0 2.0 0.0) (1.0 4.0 0.0))

((1.0 4.0 0.0) (3.0 4.0 0.0))

((3.0 4.0 0.0) (3.0 6.0 0.0)))

(sortlist lst2) ->

(((1.0 2.0 0.0) (1.0 4.0 0.0))

((1.0 4.0 0.0) (3.0 4.0 0.0))

((3.0 4.0 0.0) (3.0 6.0 0.0))

((3.0 6.0 0.0) (4.0 7.0 0.0))

((4.0 7.0 0.0) (6.0 7.0 0.0)))

Et pour faire le contour en une seule liste de points :

(defun join-lst	(lst / domino tmp rslt)

 (defun domino	(pt fun lst)
   (car (vl-member-if
'(lambda (l) (equal pt (fun l) 1e-9))
lst
     )
   )
 )
 
 (setq	rslt (car lst)
lst  (cdr lst)
 )
 (while
   (or
     (and
(setq tmp (domino (car rslt) car lst))
(setq rslt (append (reverse (cdr tmp)) rslt))
     )
     (and
(setq tmp (domino (car rslt) last lst))
(setq rslt (append (reverse (cdr (reverse tmp))) rslt))
     )
     (and
(setq tmp (domino (last rslt) car lst))
(setq rslt (append rslt (cdr tmp)))
     )
     (and
(setq tmp (domino (last rslt) last lst))
(setq rslt (append rslt (cdr (reverse tmp))))
     )
   )
    (setq lst (vl-remove tmp lst))
 )
 rslt
)

(join-lst lst2)

((1.0 2.0 0.0) (1.0 4.0 0.0) (3.0 4.0 0.0) (3.0 6.0 0.0) (4.0 7.0 0.0) (6.0 7.0 0.0))

[Edité le 26/5/2007 par (gile)]

Didier-AD · le 26 mai 2007

vl-member-if !!!!!!!!

en voilà une qui m'avait échappé.....je m'en souviendrai

moi, j'avais prévu ceci, avec une sécurité, (indice n) dans le cas où les segments ne se rejoignent pas

 
(defun sortlist (l / lf n)
 (setq lf (list (car l))
l (cdr l)
n 0
 )
 (while (and l (< n (length l)))
   (cond
     ((equal (caar l) (cadr (last lf)) 1e-9)
      (setq lf (append lf (list (car l)))
     l (cdr l)
     n 0
      )
     )
     ((equal (cadar l) (caar lf) 1e-9)
      (setq lf (cons (car l) lf)
     l (cdr l)
     n 0
      )
     )
     ((equal (caar l) (caar lf) 1e-9)
      (setq lf (cons (reverse (car l)) lf)
     l (cdr l)
     n 0
      )
     )
     ((equal (cadar l) (cadr (last lf)) 1e-9)
      (setq lf (append lf (list (reverse (car l))))
     l (cdr l)
     n 0
      )
     )
     (t (setq l (append (cdr l) (list (car l)))
       n (1+ n)
 )
     )
   )
 )
 lf
)

mais BonusCAD a fini par résoudre son problème et n'en a donc plus besoin.

Bon WE à tous

Patrick_35 · le 26 mai 2007

Salut

Une autre manière de faire

(defun Sortlist (lst / lst2 lst3 n)
(setq lst2 (vl-sort (append
	      (mapcar '(lambda (x)(car x)) lst)
	      (mapcar '(lambda (x)(cadr x)) lst)
	    )
	    '(lambda (a b)
	      (if (eq (car a)(car b))
		(< (cadr a)(cadr b))
		(< (car a)(car b))
	      )
	    )
   )
     n 0
)
(while (nth n lst2)
 (setq lst3 (cons (list (nth n lst2) (nth (1+ n) lst2)) lst3))
 (setq n (+ 2 n))
)
(reverse lst3)
)

@+

Didier-AD · le 27 mai 2007

désolé, Patrick mais çà ne fonctionne toujours pas

avec

(setq lz '(((3.0 4.0 0.0) (3.0 6.0 0.0)) ((1.0 2.0 0.0) (1.0 4.0 0.0))

((1.0 4.0 0.0) (3.0 4.0 0.0)) ((3.0 6.0 0.0) (4.0 7.0 0.0))

((6.0 7.0 0.0) (6.0 4.0 0.0)) ((6.0 4.0 0.0) (7.0 3.0 0.0))

((12.0 3.0 0.0) (1.0 2.0 0.0)) ;;;segment ajouté pour fermer le contour

((4.0 7.0 0.0) (6.0 7.0 0.0)) ((7.0 3.0 0.0) (9.0 3.0 0.0))

((9.0 3.0 0.0) (10.0 5.0 0.0)) ((12.0 5.0 0.0) (12.0 3.0 0.0))

((10.0 5.0 0.0) (12.0 5.0 0.0))

))

(SortList Lz) retourne

((1.0 2.0 0.0) (1.0 2.0 0.0))

((1.0 4.0 0.0) (1.0 4.0 0.0))

((3.0 4.0 0.0) (3.0 4.0 0.0))

((3.0 6.0 0.0) (3.0 6.0 0.0))

((4.0 7.0 0.0) (4.0 7.0 0.0))

((6.0 4.0 0.0) (6.0 4.0 0.0))

((6.0 7.0 0.0) (6.0 7.0 0.0))

((7.0 3.0 0.0) (7.0 3.0 0.0))

((9.0 3.0 0.0) (9.0 3.0 0.0))

((10.0 5.0 0.0) (10.0 5.0 0.0))

((12.0 3.0 0.0) (12.0 3.0 0.0))

Patrick_35 · le 28 mai 2007

Oui, tout à fait car il ne répond pas à ta liste le mais à la liste lst2 de (gile)

Je n'ai pas encore eu le temps de me pencher sur ta liste

@+

Patrick_35 · le 28 mai 2007

Donc pour Didier-AD

(setq lz '(((3.0 4.0 0.0) (3.0 6.0 0.0)) ((1.0 2.0 0.0) (1.0 4.0 0.0))
((1.0 4.0 0.0) (3.0 4.0 0.0)) ((3.0 6.0 0.0) (4.0 7.0 0.0))
((6.0 7.0 0.0) (6.0 4.0 0.0)) ((6.0 4.0 0.0) (7.0 3.0 0.0))
((12.0 3.0 0.0) (1.0 2.0 0.0)) ;;;segment ajouté pour fermer le contour
((4.0 7.0 0.0) (6.0 7.0 0.0)) ((7.0 3.0 0.0) (9.0 3.0 0.0))
((9.0 3.0 0.0) (10.0 5.0 0.0)) ((12.0 5.0 0.0) (12.0 3.0 0.0))
((10.0 5.0 0.0) (12.0 5.0 0.0))
))

(defun sortlist (lz / lst pair)
 (setq lst (list (car lz)) lz (cdr lz))
 (while lz
   (setq pair (car (vl-remove-if-not '(lambda(x) (equal (car x) (cadr (last lst)) 1e-9)) lz))
  lz (vl-remove pair lz)
  lst (append lst (list pair))
   )
 )
)

(sortlist lz)

(((3.0 4.0 0.0) (3.0 6.0 0.0)) ((3.0 6.0 0.0) (4.0 7.0 0.0)) ((4.0 7.0 0.0)

(6.0 7.0 0.0)) ((6.0 7.0 0.0) (6.0 4.0 0.0)) ((6.0 4.0 0.0) (7.0 3.0 0.0))

((7.0 3.0 0.0) (9.0 3.0 0.0)) ((9.0 3.0 0.0) (10.0 5.0 0.0)) ((10.0 5.0 0.0)

(12.0 5.0 0.0)) ((12.0 5.0 0.0) (12.0 3.0 0.0)) ((12.0 3.0 0.0) (1.0 2.0 0.0))

((1.0 2.0 0.0) (1.0 4.0 0.0)) ((1.0 4.0 0.0) (3.0 4.0 0.0)))

@+

[Edité le 28/5/2007 par Patrick_35]

Didier-AD · le 28 mai 2007

Impeccable cette fois ci

et très très concis ; bravo !

(gile) · le 28 mai 2007

Impeccable cette fois ci

Je crains que non, avec la première liste et celle que je donnais la routine entre dans une boucle sans fin.

Il me semble qu'il est inévitable de tester les 4 possibilités de jonction : car/car, car/last, last/car, last/last.

Patrick_35 · le 28 mai 2007

Sauf que ta liste comporte des erreurs. 4 éléments uniques alors qu'au pire, on devrait en avoir 2

(setq lst2
'(((3.0 4.0 0.0) (3.0 6.0 0.0))
((1.0 2.0 0.0) (1.0 4.0 0.0))
((6.0 4.0 0.0) (7.0 3.0 0.0))
((4.0 7.0 0.0) (6.0 7.0 0.0))
((3.0 4.0 0.0) (1.0 4.0 0.0))
((4.0 7.0 0.0) (3.0 6.0 0.0)))
)

(setq lst (append (mapcar 'car lst2)(mapcar 'cadr lst2)))
(while lst
 (setq n (length lst)
js (car lst)
lst (vl-remove js lst)
tbl (cons (cons js (- n (length lst))) tbl)
 )
)
(setq lst (vl-sort tbl '(lambda (a b) (< (cdr a) (cdr b)))))

Retourne

(((6.0 7.0 0.0) . 1) ((7.0 3.0 0.0) . 1)((6.0 4.0 0.0) . 1)

((1.0 2.0 0.0) . 1) ((1.0 4.0 0.0) . 2) ((3.0 6.0 0.0) . 2)

((4.0 7.0 0.0) . 2) ((3.0 4.0 0.0) . 2))

@+

(gile) · le 28 mai 2007

Sauf que ta liste comporte des erreurs

J'avais volontairement mis un doublet qui ne se raccordait à aucun autre, pensant qu'il était intéressant que la routine écarte ce type de doublet.

Mais il me semble bien que le problème avec ta routine ne vienne pas de là.

Elle ne fonctionne ni avec la première liste donné par Didier_ad, ni avec lst2 sans le doublet ((6.0 4.0 0.0) (7.0 3.0 0.0)), ni avec lz si on inverse un doublet.

Patrick_35 · le 28 mai 2007

J"avoue ne plus te comprendre :exclam:

@+

(gile) · le 28 mai 2007

Dans son premier message Didier parlait de deux niveaux : un premier avec les doublets qui se "raccordent" sans avoir besoin de les inverser, un second où les points dans les doublets pouvaient avoir besoin d'être inversés pour pouvoir se "raccorder". Enfin c'est comme ça que je l'ai compris. C'est pour ça que je pense que la routine doit fonctionner si dans la liste lz on inverse un (ou plusieurs) doublet.

Pour ma part, j'avais aussi pensé que la routine devrait fonctionner même si un (ou plusieurs) doublets ne se raccordaient pas aux autres, dans ce cas ceux-ci étaient écartés du résultat.

C'est ce que font les routines que Didier et moi avons proposé.

(gile) · le 27 juillet 2007

Un exemple d'utilisation de la méthode donnée par didier_AD (à mon avis la plus fiable et rapide), une nouvelle version de Join3dPoly en Visual LISP :

;;; PlinePtLst Retourne la liste des sommets (coordonnées SCG) de la polyligne (vla-object)

(defun PlinePoints (pl / sub)
 (vl-load-com)
 (or (= (type pl) 'VLA-OBJECT)
     (setq pl (vlax-ename->vla-object pl))
 )

 (defun sub (l e n)
   (if	l
     (cons (trans (list (car l) (cadr l) e) n 0)
    (sub (cddr l) e n)
     )
   )
 )

 (sub (vlax-get pl 'Coordinates)
      (vla-get-Elevation pl)
      (vlax-get pl 'Normal)
 )
)


;;; 3d-coord->pt-lst Convertit une liste de coordonnées 3D en liste de points
;;; (3d-coord->pt-lst '(1.0 2.0 3.0 4.0 5.0 6.0)) -> ((1.0 2.0 3.0) (4.0 5.0 6.0))

(defun 3d-coord->pt-lst	(lst)
 (if lst
   (cons (list (car lst) (cadr lst) (caddr lst))
  (3d-coord->pt-lst (cdddr lst))
   )
 )
)

;;===============================================================================;;

(defun c:Join3dPoly (/ AcDoc Space ss lst plst olst n 3p)
 (vl-load-com)
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
 )
 (while (not (ssget '((-4 . "		       (0 . "LINE")
	       (-4 . "		       (0 . "POLYLINE")
	       (70 . 8)
	       (-4 . "AND>")
	       (-4 . "		       (0 . "LWPOLYLINE")
	       (70 . 0)
	       (-4 . "AND>")
	       (-4 . "OR>")
	      )
      )
 )
 )
 (setq ss (vla-get-ActiveSelectionSet AcDoc))
 (vlax-for obj	ss
   (cond
     ((= (vla-get-ObjectName obj) "AcDbLine")
      (setq lst (cons
	   (cons obj
		 (list (vlax-get obj 'StartPoint)
		       (vlax-get obj 'EndPoint)
		 )
	   )
	   lst
	 )
      )
     )
     ((= (vla-get-ObjectName obj) "AcDbPolyline")
      (setq lst (cons (cons obj (PlinePoints obj)) lst))
     )
     ((= (vla-get-ObjectName obj) "AcDb3dPolyline")
      (setq lst
      (cons
	(cons obj (3d-coord->pt-lst (vlax-get obj 'Coordinates)))
	lst
      )
      )
     )
   )
 )
 (while (and lst (    (setq plst (cdar lst)
  olst (list (caar lst))
  lst  (cdr lst)
  n    0
   )
   (while (and lst (      (cond
((equal (cadar lst) (last plst) 1e-9)
 (setq plst (append plst (cddar lst))
       olst (cons (caar lst) olst)
       lst  (cdr lst)
       n    0
 )
)
((equal (last (cdar lst)) (car plst) 1e-9)
 (setq plst (append (cdar lst) (cdr plst))
       olst (cons (caar lst) olst)
       lst  (cdr lst)
       n    0
 )
)
((equal (cadar lst) (car plst) 1e-9)
 (setq plst (append (reverse (cdar lst)) (cdr plst))
       olst (cons (caar lst) olst)
       lst  (cdr lst)
       n    0
 )
)
((equal (last (cdar lst)) (last plst) 1e-9)
 (setq plst (append plst (cdr (reverse (cdar lst))))
       olst (cons (caar lst) olst)
       lst  (cdr lst)
       n    0
 )
)
(T
 (setq lst (append (cdr lst) (list (car lst)))
       n   (1+ n)
 )
)
     )
   )
 )
 (if (and (= 1 (setq n (length olst))) (    (princ "\nObjets non jointifs.")
   (progn
     (vla-StartUndoMark AcDoc)
     (vlax-invoke Space 'add3dPoly (apply 'append plst))
     (if (= 1 n)
(princ "\n1 objet a été transformé en polyligne 3d.")
(princ (strcat "\n"
	       (itoa n)
	       " objets ont été joints en une polyligne 3d."
       )
)
     )
     (mapcar 'vla-delete olst)
     (vla-EndUndoMark AcDoc)
   )
 )
 (vla-delete ss)
 (princ)
)

(gile) · le 5 mai 2011

Salut,

Je déterre ce sujet pour donner une autre solution.

La liste en entrée est une liste de 'doublets' (ou segments)

La liste retournée est une liste de points correspondant aux séries de segments jointifs.

(joinSegs '((2 8) (5 3) (1 2) (1 9) (7 3))) retourne ((7 3 5) (9 1 2 8))

Pour le fun, elle utilise deux fonctions mutuellement récursives.

(defun joinSegs	(segs / foo bar)
 
 (defun foo (segs acc)
   (if	segs
     (bar (car segs) (cdr segs) acc)
     acc
   )
 )
 
 (defun bar (new segs acc / fst lst tmp)
   (setq fst (car new)
  lst (last  new)
   )
   (cond
     ((setq tmp (assoc fst segs))
      (bar (cons (cadr tmp) new) (vl-remove tmp segs) acc)
     )
     ((setq tmp (assoc lst segs))
      (bar (cons (cadr tmp) (reverse new)) (vl-remove tmp segs) acc)
     )
     ((setq tmp (assoc fst (setq segs (mapcar 'reverse segs))))
      (bar (cons (cadr tmp) new) (vl-remove tmp segs) acc)
     )
     ((setq tmp (assoc lst segs))
      (bar (cons (cadr tmp) (reverse new)) (vl-remove tmp segs) acc)
     )
     (T (foo segs (cons new acc)))
   )
 )

 (foo segs nil)
)

Dans la pratique, on peut l'utiliser pour convertir une sélection de lignes jointives en une ou plusieurs polylignes 3d.

(defun c:autojoin (/ n ss elst lst)
 (if (setq ss (ssget '((0 . "LINE"))))
   (progn
     (repeat (setq n (sslength ss))
(setq elst (entget (ssname ss (setq n (1- n))))
      lst  (cons (list (cdr (assoc 10 elst)) (cdr (assoc 11 elst))) lst)
)
     )
     (foreach l (joinSegs lst)
(entmake '((0 . "POLYLINE") (70 . 8)))
(mapcar '(lambda (v) (entmake (list '(0 . "VERTEX") (cons 10 v) '(70 . 32)))) l)
(entmake '((0 . "SEQEND")))
     )
   )
 )
)

Connexion

challenge 8 (ou le jeu des dominos)

Messages recommandés

Didier-AD

Patrick_35

ElpanovEvgeniy

(gile)

Patrick_35

(gile)

Didier-AD

(gile)

Didier-AD

Patrick_35

Didier-AD

Patrick_35

Patrick_35

Didier-AD

(gile)

Patrick_35

(gile)

Patrick_35

(gile)

(gile)

(gile)

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante