Inverser les sommets d\'une polyligne

[(gile)]

Une petite routine qui inverse les sommets d'une polyligne.

 

Toutes les proptiétés sont conservées (arcs, largeurs, couleur, calque, type de ligne ...)

 

NOUVELLE VERSION

 

Accepte les polylignes 2D, 3D ou optimisées (lwpolyline)

 

;;; R_PLINE -Gilles Chanteau-
;;; Inverse l'ordre de sommets d'une polyligne (2D, 3D ou optimisée)
;;; Toutes les propriétés de la polyligne sont conservées (arcs, largeurs ...)

;; Inverse l'ordre de sommets d'une lwpolyligne, d'une polyligne 2D ou 3D

(defun reverse_pline (ent / e_lst vtx v_lst p_lst l_vtx)
 (setq e_lst (entget ent))
 (cond
   ((= (cdr (assoc 0 e_lst)) "POLYLINE")
    (setq vtx (entnext ent))
    (while (= (cdr (assoc 0 (entget vtx))) "VERTEX")
      (setq v_lst (cons (entget vtx) v_lst)
     vtx   (entnext vtx)
      )
    )
   )
   ((= (cdr (assoc 0 e_lst)) "LWPOLYLINE")
    (setq p_lst (vl-remove-if-not
	   '(lambda (x)
	      (member (car x) '(10 40 41 42))
	    )
	   e_lst
	 )
   e_lst (vl-remove-if
	   '(lambda (x)
	      (member x p_lst)
	    )
	   e_lst
	 )
    )
    (while p_lst
      (setq v_lst (cons
	     (list (car p_lst) (cadr p_lst) (caddr p_lst) (cadddr p_lst))
	     v_lst
	   )
     p_lst (member (assoc 10 (cdr p_lst)) (cdr p_lst))
      )
    )
   )
 )
 (setq	l_vtx (last v_lst)
l_vtx (subst (cons 40 (cdr (assoc 41 (car v_lst))))
	     (assoc 40 l_vtx)
	     l_vtx
      )
l_vtx (subst (cons 41 (cdr (assoc 40 (car v_lst))))
	     (assoc 41 l_vtx)
	     l_vtx
      )
l_vtx (subst (cons 42 (- (cdr (assoc 42 (car v_lst)))))
	     (assoc 42 l_vtx)
	     l_vtx
      )
 )
 (setq	v_lst
 (mapcar
   '(lambda (x y)
      (setq x (subst (cons 40 (cdr (assoc 41 y))) (assoc 40 x) x)
	    x (subst (cons 41 (cdr (assoc 40 y))) (assoc 41 x) x)
	    x (subst (cons 42 (- (cdr (assoc 42 y)))) (assoc 42 x) x)
      )
    )
   v_lst
   (cdr v_lst)
 )
 )
 (if (= (logand 1 (cdr (assoc 70 e_lst))) 1)
   (setq v_lst (append (list l_vtx) v_lst))
   (setq v_lst (append v_lst (list l_vtx)))
 )
 (cond
   ((= (cdr (assoc 0 e_lst)) "POLYLINE")
    (mapcar 'entmake
     (append (list e_lst) v_lst (list (entget vtx)))
    )
    (entdel ent)
   )
   ((= (cdr (assoc 0 e_lst)) "LWPOLYLINE")
    (setq e_lst (append e_lst (apply 'append v_lst)))
    (entmod e_lst)
   )
 )
)

;;; R_PLINE Fonction d'appel

(defun c:r_pline (/ ent)
 (while (not (setq ent (car (entsel)))))
 (if (or (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
  (and (= (cdr (assoc 0 (entget ent))) "POLYLINE")
       (zerop (logand 240 (cdr (assoc 70 (entget ent)))))
  )
     )
   (reverse_pline ent)
   (prompt "\nEntité non valide")
 )
 (princ)
)

[Edité le 12/7/2006 par (gile)]

[Edité le 16/7/2006 par (gile)]

[Patrick_35]

Salut (gile)

 

Je pense que c'est un peu plus court ;)

 

@+

 

(if (setq sel (car (entsel)))
 (progn
   (setq sel (entget sel))
   (if (eq (cdr (assoc 0 sel)) "LWPOLYLINE")
     (progn
       (setq sel (append  (vl-remove-if     '(lambda (x) (= (car x) 10)) sel)
                 (reverse (vl-remove-if-not '(lambda (x) (= (car x) 10)) sel))))
       (entmod sel)
     )
   )
 )
)

[Bred]

Salut à vous 2.

Pourriez-vous m'expliquer la (l'une des) raison "d'inverser les sommets d'une polyligne" ?

merci

[Fraid]

bonjour bred,

 

En vrd nous nous servons de types de lignes contenant des lettres

cela permet de les avoir dans le sens de lectures du plan

 

il doit y avoir d'autres occasion d'utiliser ce lisp que j'utilise depuis deja depuis un certain temps

 

voici la version que j'ai recupere je ne sais plus ni quand

 

(Defun dd_ext ( cle e / )

(if (= 'ENAME (type e)) (setq e (entget e)))

(cdr (assoc cle e))

)

 

(Defun dd_snoc ( elem li / )

(append li (list elem))

)

 

(Defun dd_analpol ( pol / e ent ll alti)

(setq ll '() e pol)

(cond

((= "POLYLINE" (dd_ext 0 pol))

(while (/= "SEQEND" (dd_ext 0 (setq ent (entget (setq e (entnext e))))))

(setq ll (cons (list (trans (dd_ext 10 ent) pol 1) (dd_ext 42 ent)) ll))

)

)

((= "LWPOLYLINE" (dd_ext 0 pol))

(setq ent (entget pol) ptcrb nil alti 0.0)

(while ent

(if (= 38 (caar ent)) (setq alti (cdar ent)) )

(if (= 10 (caar ent)) (setq ptcrb (trans (snoc alti (dd_xy (cdar ent))) pol 1)))

(if (= 42 (caar ent)) (setq ll (cons (list ptcrb (cdar ent)) ll)))

(setq ent (cdr ent))

)

)

)

(if (= 1 (logand (dd_ext 70 pol) 1))

(dd_snoc (last ll) (reverse ll))

(setq ll (reverse ll)

ll (dd_snoc (list (car (last ll)) 0.0) (reverse (cdr (reverse ll))))

)

)

)

 

(Defun dd_reversepol ( lpc / )

(if (= 'ENAME (type lpc)) (setq lpc (dd_analpol lpc)))

(mapcar '(lambda (x1 x2)

(list (car x1) (* (cadr x2) -1))

)

 

(reverse lpc)

(dd_snoc (last lpc) (cdr (reverse lpc)))

 

)

)

 

(Defun dd_tracepol ( lpc / lp)

(setq lp (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity")

(cons 67 0)

(cons 100 "AcDbPolyline") (cons 90 (length lpc))

(cons 70 0) (cons 43 0)

(cons 38 0.0) (cons 39 0.0)

 

)

)

(foreach vert lpc

(setq lp (append lp (list (cons 10 (car vert))

(cons 42 (cadr vert))

)

)

)

 

)

(setq lp (append lp (list (cons 210 (list 0.0 0.0 1.0)))))

(entmake lp)

)

 

 

 

 

(Defun C:Retournepol ( / e lp)

(setq e (car (entsel "\npointer une polyligne")))

(if (and e (member (dd_ext 0 e) '("POLYLINE" "LWPOLYLINE")))

(progn

(setq lp (dd_reversepol e))

(entdel e)

(dd_tracepol lp)

)

)

)

 

 

[Edité le 12/7/2006 par Fraid]

[Tramber]

Salut, le lisp que tu as viens de :

;; créée le : mardi 16 février 1999 à 21:05

;;DIDIER DUHEM

 

Pour Bred : pour ma part j'inverse des polylignes pour ce genre de programmes.

[(gile)]

Je pense que c'est un peu plus court

 

Et c'est un euphémisme, mais ma routine conserve les arcs et les largeurs (codes 40 41 42), ceci doit expliquer cela. ;)

 

 

J'ai scindé le LISP (tout en haut) en deux routines :

 

- reverse_pline : une routine qui peut être appelée depuis un LISP et dont l'argument doit être le nom d'entité (ename) d'une lwpolyligne.

 

- r_pline : une commande qui demande à l'utilisateur de sélectionner une polyligne et lance reverse_pline si l'entité est valide.

[(gile)]

J'ai complété le LISP,

 

il fonctionne désormais aussi bien avec les polylignes 2D et 3D,

les arcs, les largeurs de ligne, le point de départ des polylignes fermées, ainsi que toutes les autres propriétés sont conservés.

 

J'ai réparé un dysfonctionnement avec la courbure et la largeur du dernier segment des lwpolylignes.

[(gile)]

Bonuscad avait déjà attiré mon attention sur la pureté du style des LISP de Elpanov Evgeniy ici ou là.

 

Si les routines pour inverser les sommets d'une polyligne ne sont pas rares sur le net et que j'étais plutôt assez fier de ce que j'avais écris, celle que donne Elpanov (ou Yelpanov ?)dans ce sujet me laisse carrément sans voie !

 

J'ai refait le lien ...

 

[Edité le 3/8/2006 par (gile)]

[(gile)]

Je copie ici le code en question, issu du Forum Autodesk - Discussion Groups

 

Discussion Groups Index > AutoCAD Groups > Visual LISP, AutoLISP and General Customization Issues > How to distingu a close polyline is clockwise direction or counter-clockwise ?

 

Patrick, si tu y vois un inconvenient, tu peut supprimer le message, il restera le lien ci dessus.

 

;Reverse "LWPOLYLINE"

(defun c:rlw (/ E LW X1 X2 X3 X4 X5 X6)
;   Writer Evgeniy Elpanov.
 (if (and (setq lw (car (entsel "\nSelect lwpolyline")))
          (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE")
     ) ;_  and
   (progn
     (foreach a1 e
       (cond
         ((= (car a1) 10) (setq x2 (cons a1 x2)))
         ((= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)))
         ((= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)))
         ((= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)))
         ((= (car a1) 210) (setq x6 (cons a1 x6)))
         (t (setq x1 (cons a1 x1)))
       ) ;_  cond
     ) ;_  foreach
     (entmod
       (append
         (reverse x1)
         (append
           (apply
             (function append)
             (apply
               (function mapcar)
               (cons
                 'list
                 (list x2
                       (cdr (reverse (cons (car x3) (reverse x3))))
                       (cdr (reverse (cons (car x4) (reverse x4))))
                       (cdr (reverse (cons (car x5) (reverse x5))))
                 ) ;_  list
               ) ;_  cons
             ) ;_  apply
           ) ;_  apply
           x6
         ) ;_  append
       ) ;_  append
     ) ;_  entmod
     (entupd lw)
   ) ;_  progn
 ) ;_  if
) ;_  defun

[BIM G CO]

Je ne connais pas la durée de vie de CADxp.com mais j'aime bien ajouter le lien où j'ai trouvé l'information ex (gile) pour ta routine ajouter ce commentaire

 

 ;;; http://www.cadxp.com/sujetXForum-10953.htm

 

donne à un utilisateur futur de venir.... je sais c'est la pub gratuite :P

 

 

[Edité le 28/9/2007 par Maximilien]