Rejoindre deux polylignes parallèles en créant

[Johann]

Bonjour,

je cherche à rejoindre deux polylignes parallèle en créant des trait automatiquement afin de créer une forme fermée.

Connaissez vous une méthode pour effectuer cette opération?

[sechanbask]

faire un rectangle ?

n'hésite pas à attacher un fichier pour qu'on comprenne mieux ce que tu souhaites ?

[Johann]

Oui, sur le même principe qu'un rectangle mais qui fonctionnerais pour des formes qui serait en polyligne décalé. J'ai du mal à exprimer ma demande, mais en gros ce serait comme sûr l'image joint, mais de manière automatique en sélectionnant les deux polylignes cela générerait deux autre trait afin de fermé l'ensemble. Merci.http://zupimages.net/up/15/14/o42s.jpg

[zebulon_]

Bonjour,

 

essaye ceci

 

(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)
)

(defun c:Ferme2poly ()

 (setq poly1 (car (entsel)))
 (setq poly2 (car (entsel)))

 (setq PTD1 (car (massoc 10 (entget poly1))))
 (setq PTD2 (car (massoc 10 (entget poly2))))
 (setq PTF1 (car (reverse (massoc 10 (entget poly1)))))
 (setq PTF2 (car (reverse (massoc 10 (entget poly2)))))

 (if (inters PTD1 PTD2 PTF1 PTF2)
   (command "_line" "_non" (trans PTD1 0 1) "_non" (trans PTF2 0 1) "")
   (command "_line" "_non" (trans PTD1 0 1) "_non" (trans PTD2 0 1) "")
 )

 (command "_pedit" poly1 "_j" poly2 (entlast) "" "_c" "")

 (princ)
)

 

Amicalement

Vincent

[Patrick_35]

Salut

 

Un lisp vite fait

 

(defun c:jpe(/ ent1 ent2 ent3)
 (and 	(setq ent1 (entsel "\nSélectionnez la polyligne de référence : "))
(setq ent2 (entsel "\nSélectionnez la polyligne à joindre : "))
(setq ent1 (entget (car ent1)))
(setq ent2 (entget (car ent2)))
(eq (cdr (assoc 0 ent1)) "LWPOLYLINE")
(eq (cdr (assoc 0 ent2)) "LWPOLYLINE")
(setq ent3 (append (vl-remove-if '(lambda(x)(vl-position (car x) '(-1 5 330))) ent1) (reverse (vl-remove-if-not '(lambda(x)(eq (car x) 10)) ent2))))
(setq ent3 (subst (cons 90 (+ (cdr (assoc 90 ent1)) (cdr (assoc 90 ent2)))) (assoc 90 ent3) ent3))
(setq ent3 (subst (cons 70 1) (assoc 70 ent3) ent3))
(entmake ent3)
   (progn
     (entdel (cdr (assoc -1 ent1)))
     (entdel (cdr (assoc -1 ent2)))
   )
 )
 (princ)
)

 

ps : Grillé par zebulon_ mais je laisse quand même le code

 

@+

[Johann]

Merci à vous deux, c'est exactement ce que je cherchait. Celui de Patrick_35 fonctionne mieux sûr mes polylignes qui sont assez spéciales.

[Patrick_35]

Merci à vous deux, c'est exactement ce que je cherchait. Celui de Patrick_35 fonctionne mieux sûr mes polylignes qui sont assez spéciales.

Je viens de l'améliorer si les deux polylignes ne sont pas dans le même sens

 

(defun c:jpe(/ ent1 ent2 ent3 pts)
 (and 	(setq ent1 (entsel "\nSélectionnez la polyligne de référence : "))
(setq ent2 (entsel "\nSélectionnez la polyligne à joindre : "))
(setq ent1 (entget (car ent1)))
(setq ent2 (entget (car ent2)))
(eq (cdr (assoc 0 ent1)) "LWPOLYLINE")
(eq (cdr (assoc 0 ent2)) "LWPOLYLINE")
(setq pts (vl-remove-if-not '(lambda(x)(eq (car x) 10)) ent2))
(setq ent3 (append (vl-remove-if '(lambda(x)(vl-position (car x) '(-1 5 330))) ent1)
		   (if (< (distance (cdr (assoc 10 ent1)) (car pts))
			  (distance (cdr (assoc 10 ent1)) (last pts))
		       )
		     (reverse pts)
		     pts
		   )
	   )
)
(setq ent3 (subst (cons 90 (+ (cdr (assoc 90 ent1)) (cdr (assoc 90 ent2)))) (assoc 90 ent3) ent3))
(setq ent3 (subst (cons 70 1) (assoc 70 ent3) ent3))
(entmake ent3)
   (progn
     (entdel (cdr (assoc -1 ent1)))
     (entdel (cdr (assoc -1 ent2)))
   )
 )
 (princ)
)

 

@+

[philous2]

Je viens de l'améliorer si les deux polylignes ne sont pas dans le même sens

 

(defun c:jpe(/ ent1 ent2 ent3 pts)
 (and 	(setq ent1 (entsel "\nSélectionnez la polyligne de référence : "))
(setq ent2 (entsel "\nSélectionnez la polyligne à joindre : "))
(setq ent1 (entget (car ent1)))
(setq ent2 (entget (car ent2)))
(eq (cdr (assoc 0 ent1)) "LWPOLYLINE")
(eq (cdr (assoc 0 ent2)) "LWPOLYLINE")
(setq pts (vl-remove-if-not '(lambda(x)(eq (car x) 10)) ent2))
(setq ent3 (append (vl-remove-if '(lambda(x)(vl-position (car x) '(-1 5 330))) ent1)
		   (if (< (distance (cdr (assoc 10 ent1)) (car pts))
			  (distance (cdr (assoc 10 ent1)) (last pts))
		       )
		     (reverse pts)
		     pts
		   )
	   )
)
(setq ent3 (subst (cons 90 (+ (cdr (assoc 90 ent1)) (cdr (assoc 90 ent2)))) (assoc 90 ent3) ent3))
(setq ent3 (subst (cons 70 1) (assoc 70 ent3) ent3))
(entmake ent3)
   (progn
     (entdel (cdr (assoc -1 ent1)))
     (entdel (cdr (assoc -1 ent2)))
   )
 )
 (princ)
)

 

@+

Moi j'utilise celle-ci aussi qui est pas mal

 

(defun c:JPe (/ jpo:pa e elast ss s ep)

(setq elast (entlast))

 

(or (setq e (getdist "\n Tolérance entre polylignes <1> :"))

(setq e 1.0)

)

(or (setq ep (getdist "\n Epaisseur polylignes <0.5> :"))

(setq ep 0.5)

)

(setq ss (ssget))

(setq jpo:pa (getvar "peditaccept" ))

(setvar "peditaccept" 1) (vl-cmdf "_.pedit" "_m" ss "" "_j" e "")

 

(setq s nil s (ssadd))

(while (entnext elast)

(ssadd (entnext elast) s)

(setq elast (entnext elast))

)

 

(vl-cmdf "_.pedit" "_m" ss s "" "_w" ep "")

 

(setvar "peditaccept" jpo:pa)

 

(princ)

)

[zebulon_]

Merci à vous deux, c'est exactement ce que je cherchait. Celui de Patrick_35 fonctionne mieux sûr mes polylignes qui sont assez spéciales.

 

mieux, c'est à dire ?

 

Amicalement

Vincent

[pbrion]

Bonjour,

 

Moi, je trouve que c'est le lisp de Zebulon qui fonctionne mieux ! Avec juste un petit soucis dans le cas où la 1ère polyligne se termine par un arc. le raccord se fait alors en arc aussi.

 

Par contre le lisp de Patrick_35 présente le même problème, mais en plus, il remplace les arcs de la 2ème polyligne en segments droits.

 

Cordialement

[Johann]

Ah oui en effet je n'ai rien dit, c'était le sens qui clochait sûr le lisp de zebulon. Mais enfaîte les deux fonctionnent aussi bien pour les polylignes que j'ai à traiter. Encore Merci. ;)

[Patrick_35]

@philous2

Je viens de tester ton lisp et il ne répond pas à la demande Johann ?

 

@pbrion

Exact, le lisp ne traite pas des arcs de cercles.

 

@zebulon_

Tu peux éviter d'utiliser un (car (reverse ...)) avec la fonction last

 

@+

[Vince-34]

Wouha ! Franchement merçi à vous 2, c'est génial ! :)

 

N'y connaissant rien en lisp, est ce qu'il est possible "d'améliorer" en pouvant pointer aussi bien un ligne qu'une polyligne et qu'une fois raccordé cela donne une polyligne ?

[VDH-Bruno]

Slt,

@zebulon_

Tu peux éviter d'utiliser un (car (reverse ...)) avec la fonction last

Personnellement j'aurais dit tu peux économiser entget, massoc, car, reverse... avec vlax-curve-getStartPoint & vlax-curve-getEndPoint qui supportent très bien les ename. ;)

 

  (setq PTD1 (vlax-curve-getStartPoint poly1))
 (setq PTD2 (vlax-curve-getStartPoint poly2))
 (setq PTF1 (vlax-curve-getEndPoint poly1))
 (setq PTF2 (vlax-curve-getEndPoint poly2))

 

A+

(Ps: J'aime bien l'esprit de ton l'algorithme zebulon_)

[Patrick_35]

Slt,

 

Personnellement j'aurais dit tu peux économiser entget, massoc, car, reverse... avec vlax-curve-getStartPoint & vlax-curve-getEndPoint qui supportent très bien les ename. ;)

 

  (setq PTD1 (vlax-curve-getStartPoint poly1))
 (setq PTD2 (vlax-curve-getStartPoint poly2))
 (setq PTF1 (vlax-curve-getEndPoint poly1))
 (setq PTF2 (vlax-curve-getEndPoint poly2))

 

A+

(Ps: J'aime bien l'esprit de ton l'algorithme zebulon_)

Salut

 

Eh bien, voilà une chose que j'ignorais.

Dans mon esprit, une fonction vlax fait appelle à des objets vla.

 

Merci Bruno

 

@+

[zebulon_]

Eh bien, voilà une chose que j'ignorais.

Dans mon esprit, une fonction vlax fait appel à des objets vla.

pareil pour moi !

 

Tu peux éviter d'utiliser un (car (reverse ...)) avec la fonction last

Je ne m'étais jamais servi de la fonction last et elle ne faisait pas partie de mon vocabulaire. Une lacune qui vient d'être comblée !

 

J'essaye les vlax-curve, dont l'autre avantage, qui devrait plaire à Vince-34, est de fonctionner de la même manière sur des polylignes et des lignes, voire des arcs ou des arcs d'ellipse (mais dans ce denier cas, c'est PEDIT qui ne saura pas gérer des arcs d'ellipses). Par ailleurs, il faut faire attention à la variable PEDITACCEPT : si elle est à 0 alors PEDIT demande une confirmation avant de transformer une ligne en polyligne, ce qui mène à l'arrêt du lisp.

 

Pour éviter que le dernier segment soit un arc, je propose d'éviter de faire un clore et ajouter au PEDIT les 2 segments droits de fermeture.

 

 

(defun c:Ferme2poly (/ poly1 poly2 PTD1 PTD2 PTF1 PTF2 LIG1 LIG2 OLDPEDIT) 
 (vl-load-com)
 (setq poly1 (car (entsel)))
 (setq poly2 (car (entsel)))

 (setq PTD1 (vlax-curve-getStartPoint poly1))
 (setq PTD2 (vlax-curve-getStartPoint poly2))
 (setq PTF1 (vlax-curve-getEndPoint poly1))
 (setq PTF2 (vlax-curve-getEndPoint poly2))

 (if (inters PTD1 PTD2 PTF1 PTF2)
   (progn
     (command "_line" "_non" (trans PTD1 0 1) "_non" (trans PTF2 0 1) "")
     (setq LIG1 (entlast))
     (command "_line" "_non" (trans PTF1 0 1) "_non" (trans PTD2 0 1) "")
     (setq LIG2 (entlast))
   )
   (progn
     (command "_line" "_non" (trans PTD1 0 1) "_non" (trans PTD2 0 1) "")
     (setq LIG1 (entlast))
     (command "_line" "_non" (trans PTF1 0 1) "_non" (trans PTF2 0 1) "")
     (setq LIG2 (entlast))
   )
 )

 (setq OLDPEDIT (getvar "PEDITACCEPT"))
 (setvar "PEDITACCEPT" 1)

 (command "_pedit" poly1 "_j" poly2 LIG1 LIG2 "" "")

 (setvar "PEDITACCEPT" OLDPEDIT)

 (princ)
)

[Vince-34]

Merci à vous, Merci Zebulon, c'est top ! B)