Supprimer 1 sommet sur 2 d\'une polyligne

[philous2]

Slt Gile,

Je suis tombé sur ce sujet

http:// http://www.cadxp.com//modules.php?op=modload&name=XForum&file=viewthread&fid=115&tid=22504

et je me suis demandé si avec tes routines on ne pourrait pas les aménager pour supprimer 1 sommet sur 2 d'une polyligne au lieu de supprimer " sommet superposés".

Cela me serait utile car j'ai un boulot à faire sur plusieurs fichiers avec des polylignes fermées importantes d'ou ma demande de ce jour.

Toi le spécialiste de la routine penses-tu cela faisable facilement simplement par sélection par exemple

 

 

Pour une sélection unique :

(

 defun c:clean_poly (/ ent)

 (while (not

   (setq ent (car (entsel "\nSélectionnez une polyligne: ")))

 )

 )

 (or (cleanpoly ent) (princ "\nEntité non valide"))

 (princ)

)

 

 

Pour une sélection de tout le dessin (regarde l'utilisation de if pour s'assurer que le le jeu de sélection existe)

 defun c:CleanAllPoly (/ ss n)

 (if (setq ss (ssget "_X"

	      '((-4 . "
		(0 . "LWPOLYLINE")

		(-4 . "
		(0 . "POLYLINE")

		(-4 . "
		(-4 . "&")

		(70 . 112)

		(-4 . "NOT>")

		(-4 . "AND>")

		(-4 . "OR>")

	       )

       )

     )

   (repeat (setq n (sslength ss))

     (CleanPoly (ssname ss (setq n (1- n))))

   )

 )

 (princ)

)

 

Merci d'avance

 

Phil

[(gile)]

Salut,

 

N'as tu pas l'impression d'être quelque peu insistant ?

Tu as posté la même demande ici et là où bonuscad t'a donné une réponse à laquelle tu n'as pas répondu (tu n'as pas répondu ici non plus...).

 

Je suis vraiment désolé de devoir faire un peu la morale, mais personne ici n'est payé pour répondre aux demandes, alors un peu de patience et de civilité pour ceux qui le font.

Sinon ils risquent de finir par se lasser...

 

(defun c:toto (/ ss n elst nlst cnt)
 (if
   (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (repeat (setq n (sslength ss))
      (setq elst (entget (ssname ss (setq n (1- n))))
     nlst (trunc-if '(lambda (x) (= (car x) 10)) elst)
     elst (vl-member-if '(lambda (x) (= (car x) 10)) elst)
     cnt  0
      )
      (while (cddddr (cddddr elst))
 (setq nlst (append nlst
		    (list (car elst)
			  (cadr elst)
			  (caddr elst)
			  (cadddr elst)
		    )
	    )
       elst (cddddr (cddddr elst))
       cnt  (1+ cnt)
 )
      )
      (if (= 10 (caar elst))
 (setq cnt (1+ cnt))
      )
      (entmod
 (subst (cons 90 cnt) (assoc 90 nlst) (append nlst elst))
      )
    )
 )
 (princ)
)

;;; TRUNC-IF Retourne la liste tronquée à partir de la première occurrence qui
;;; retourne T à la fonction (complémentaire de celle retournée par VL-MEMBER-IF)

(defun trunc-if	(fun lst)
 (if (and lst
   (not ((eval fun) (car lst)))
     )
   (cons (car lst) (trunc-if fun (cdr lst)))
 )
)

 

 

[philous2]

BJr Giles,

 

Je suis vraiment désolé de devoir faire un peu la morale, mais personne ici n'est payé pour répondre aux demandes, alors un peu de patience et de civilité pour ceux qui le font.

Sinon ils risquent de finir par se lasser...

 

Excuses-moi de principe et d'éducation je suis en général tjrs très correct, je réponds tjrs en général.

Je respecte aussi le traval de chacun e tje les remercie sans aucun problème

Dans ce dernier sujet, je pensais tout simplement m'être mal exprimé par rapport à ma recherche tt simplement. Je reconnias aussi Gile que je ne suis pas un spécialiste et pro de la programmation autolisp.

Voilà qui es tdit mais tu avais tt à fait raison dele dire Gile.

 

Merci Giles pour la routine ci-après

 ( defun c:toto (/ pl elst nlst cnt)
 (if
   (and
     (setq pl (car (entsel "\nSélectionnez une polyligne: ")))
     (setq elst (entget pl))
     (= "LWPOLYLINE" (cdr (assoc 0 elst)))
   )
    (progn
      (setq nlst (trunc-if '(lambda (x) (= (car x) 10)) elst)
     elst (vl-member-if '(lambda (x) (= (car x) 10)) elst)
     cnt  0
      )
      (while (cddddr (cddddr elst))
 (setq nlst (append nlst
		    (list (car elst)
			  (cadr elst)
			  (caddr elst)
			  (cadddr elst)
		    )
	    )
       elst (cddddr (cddddr elst))
       cnt  (1+ cnt)
 )
      )
      (if (= 10 (caar elst))
 (setq cnt (1+ cnt))
      )
      (entmod
 (subst (cons 90 cnt) (assoc 90 nlst) (append nlst elst))
      )
    )
 )
 (princ)
)

 

 

Je l'ai enregistré e ttélchargée et j'ai c emessage d'erreur

Commande: TOTO

Sélectionnez une polyligne: ; erreur: no function definition: TRUNC-IF

C'est quoi la défénition TRUNC-IF !

Bien cette fois-ci je ne serai pas insistant (<acronym class=dict title=)

Merci d'avance Gile

 

[(gile)]

Oupps !

 

C'est un oubli de ma part, je rajoute la routine au message plus haut.

 

Je modifie aussi "toto" pour qu'il fonctionne avec un jeu de sélection.

[philous2]

Merci Giles sympa (<acronym class=dict title=)