Supprimer automatiquement 1 point tous les X points ?

[gillespj]

Bonjour tlm,

 

Existe-il une fonction qui me permettrait de supprimer 1 point tous les X points d'une polyligne (>1000 arrêtes) afin de le simplifier.

 

ou mieux un lisp qui permettrait de supprimer le point en définissant l'angle max de la direction du segment avec le segment précédant... par conséquent, beaucoup de points supprimés dans les lignes droites et peu/pas dans les courbes.

 

J'espère avoir été clair dans ma requête.

 

Merci d'avance pour vos lumières.

 

[Edité le 9/10/2009 par gillespj]

[lili2006]

Bonjour à toutes et tous,

 

As-tu essayé la routine de (gile) AddVtx&DelVtx.LSP ?

[gillespj]

Les fonctions addvtx & delvtx sont intéressantes mais ce n'est pas ce que je recherche.

 

[lecrabe]

 

Hello

 

Les possibilites de nettoyage sophistiquees sur les Polylignes existent dans MAP (ou CIVIL)

et ce quelque soit la version (2004-2010)

 

- Soit Simplification classique

- Soit SImplification de competition avec Analyse de distance + Angle

 

As tu acces a un MAP ou CIVIL ?

 

Le Decapode

 

[gillespj]

Pas de AutoCAD MAP ou CIVIL.

[bonuscad]

Bonjour

 

mieux un lisp qui permettrait de supprimer le point en définissant l'angle max de la direction du segment avec le segment précédant... par conséquent, beaucoup de points supprimés dans les lignes droites et peu/pas dans les courbes.

 

Voici un challenge concret. Étant susceptible de me rendre service aussi. J'ai commencé à plancher dessus.

 

L'action de cette routine est de linéariser automatiquement les sommets successifs qui sont alignés (colinéaire). L'entité source est conservée, la nouvelle étant dessiné avec les paramètres courants de calque, couleur etc...

 

D'après mes premiers tests cela a l'air correct à un détail près, les derniers segments aligné de la polyligne ne sont pas toujours supprimés. (Ouverture du challenge pour correction, ajout d'une option pour linéariser tous les X sommets...)

 

;Fonction l-coor2l-pt modifiée d'après une idée originale de Gilles Chanteau (gile)
;-----------
(defun l-coor2l-pt (lst flag / )
 (if lst
   (cons (list (car lst) (cadr lst) (if flag (caddr lst) 0.0))
     (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
   )
 )
)
;-----------
(vl-load-com)
(defun c:lxpedit ( / jspl nbr n AcDoc Space ent_name K l_pt a_ref nw_pl)
(setq
	jspl
		(ssget
			'((-4 . "					(-4 . "						(0 . "POLYLINE")
					(-4 . "							(-4 . "&") (70 . 112)
					(-4 . "NOT>")
				(-4 . "AND>")
				(0 . "LWPOLYLINE")
			(-4 . "OR>"))
		)
	nbr -1
	n 0
)
(cond
	(jspl
		(setq
			AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
			Space
			(if (eq (getvar "CVPORT") 1)
				(vla-get-PaperSpace AcDoc)
				(vla-get-ModelSpace AcDoc)
			)
		)
     (vla-StartUndoMark AcDoc)
		(prompt "\nRecherche des sommets concernés en cours ...\\")
		(repeat (sslength jspl)
			(setq ent_name (ssname jspl (setq nbr (1+ nbr))) K T)
			(setq l_pt
				(if (eq (vla-get-ObjectName (setq ename (vlax-ename->vla-object ent_name))) "AcDbPolyline")
					(l-coor2l-pt (vlax-get ename 'Coordinates) nil)
					(l-coor2l-pt (vlax-get ename 'Coordinates) T)
				)
			)
			(while K
				(cond
					((eq n 0)
						(prompt "\rRecherche des sommets concernés en cours ...|")
					)
					((eq n 1)
						(prompt "\rRecherche des sommets concernés en cours .../")
					)
					((eq n 2)
						(prompt "\rRecherche des sommets concernés en cours ...-")
					)
					((eq n 3)
						(prompt "\rRecherche des sommets concernés en cours ...\\")
					)
				)
				(setq n (rem (1+ n) 4) lst_pt (list (setq a (car l_pt))) K nil)
				(while (cddr l_pt)
           (if (equal (angle a (cadr l_pt)) (angle a (caddr l_pt)) 1E-8)
             (progn
               (while (and (cddr l_pt) (equal (angle a (cadr l_pt)) (angle a (caddr l_pt)) 1E-8))
                 (setq l_pt (cdr l_pt))
               )
               (setq lst_pt (cons (setq a (cadr l_pt)) lst_pt) K T)
             )
						(setq lst_pt (cons (setq a (caddr l_pt)) (cons (cadr l_pt) lst_pt)) l_pt (cdr l_pt))
					)
					(setq l_pt (cdr l_pt) K nil)
				)
				(cond
           ((> (length lst_pt) 1)
             (setq a_ref (angle (cadr lst_pt) (car lst_pt)))
             (if (and (cdr l_pt) (equal a_ref (angle (car l_pt) (cadr l_pt)) 1E-8))
               (setq l_pt (append (reverse (cdr lst_pt)) (cdr l_pt)) lst_pt (list (car l_pt)))
               (setq l_pt (append (reverse lst_pt) l_pt) lst_pt (list (car l_pt)))
             )
           )
         )
			)
			(setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car l_pt) (mapcar 'cadr l_pt)))))
			(if (member (vla-get-ObjectName ename) '("AcDbPolyline" "AcDb2dPolyline"))
         (progn
           (vla-put-Normal nw_pl (vlax-3d-point (vlax-get ename 'Normal)))
           (vla-put-Elevation nw_pl (vlax-get ename 'Elevation))
         )
         (vla-put-Normal nw_pl (vlax-3d-point '(0 0 1)))
       )
			(vla-put-Closed nw_pl (vlax-get ename 'Closed))
		)
     (vla-EndUndoMark AcDoc)
     (vlax-release-object Space)
     (vlax-release-object AcDoc)
		(princ
			(strcat
				"\n"
				(itoa (sslength jspl))
				" entité(s) soumises à la commande. TERMINE !"
			)
		)
	)
	(T (princ "\nPas d'entités conformes sélectionnées..!"))
)
(prin1)
)

 

NB: Cette routine SUPPRIME tous les segments courbes des polylignes.

 

Code corrigé, TOUS les points colinéaires entre sommets sont supprimés.

 

 

[Edité le 13/10/2009 par bonuscad]

[(gile)]

Salut,

 

Javais fait un truc pour les polylignes 3d ici.

Il n'y a pas grand chose à faire pour l'adapter aux polylignes...