Aller au contenu

Supprimer automatiquement 1 point tous les X points ?


gillespj

Messages recommandés

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]

Lien vers le commentaire
Partager sur d’autres sites

 

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

 

Autodesk Expert Elite Team

Lien vers le commentaire
Partager sur d’autres sites

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]

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité