Rejoindre deux polylignes parallèles en créant

Johann · le 1 avril 2015

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 · le 1 avril 2015

faire un rectangle ?

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

Johann · le 1 avril 2015

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_ · le 1 avril 2015

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 · le 1 avril 2015

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 · le 1 avril 2015

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 · le 1 avril 2015

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 · le 1 avril 2015

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_ · le 1 avril 2015

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 · le 1 avril 2015

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 · le 1 avril 2015

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 · le 1 avril 2015

@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 · le 1 avril 2015

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 · le 1 avril 2015

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 · le 1 avril 2015

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_ · le 1 avril 2015

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 · le 1 avril 2015

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

Connexion

Rejoindre deux polylignes parallèles en créant

Messages recommandés

Johann

sechanbask

Johann

zebulon_

Patrick_35

Johann

Patrick_35

philous2

zebulon_

pbrion

Johann

Patrick_35

Vince-34

VDH-Bruno

Patrick_35

zebulon_

Vince-34

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante