Doublons de points dans polylignes

[Tramber]

Je recherche un code qui élimine les points définits en double dans une poly.

 

Ca peut se faire, mais si ca existe tout fait ?!

 

Merci à tou(te)s

[Pako]

Salut Trambler,

 

Dans le super Express Tools,

on y retrouve la commande : OVERKILL (méchante commande) ... :casstet:

 

http://img62.exs.cx/img62/2432/sanstitre3nk.jpg

 

 

 

Tu peux t'expirer du code de cette commande

que l'on retrouve dans le répertoire /express/ ,

dans les fichiers : overkill.lsp & overkilsup.lsp

 

Have Fun ! ;)

 

l'ACADien !

[bonuscad]

Tramber,

 

Je viens de retomber sur une routine que je m'etais écrite pour un besoin spécifique. Le but n'était pas le même, mais malgré tout elle peut répondre a ce besoin de doublon de sommet en donnant comme "inter-distance minimale à conserver" une distance très petite ex: 0.001

 

NB: je l'ai écrite pour un besoin très spécifique dans une situation bien précise (plan vectorisé), a utiliser AVEC PRECAUTION. Mais tu peux t'inspirer du code.

(defun lxperr (ch)
(cond
	((eq ch "Function cancelled") nil)
	((eq ch "quit / exit abort") nil)
	((eq ch "console break") nil)
	(T (princ ch))
)
(setq *error* olderr)
(princ)
)
(defun c:lxpedit ( / olderr jspl nbr n tol ent_nam ent_sel ent_dxf vrtx1 vtrx2
                    a1 a2 ang lst_a tst_vrtx lst_pt nbs cnt nw count)
(setvar "cmdecho" 0)
(setq olderr *error* *error* lxperr)
(setq
	jspl
		(ssget
			'((-4 . "					(-4 . "						(0 . "POLYLINE")
					(-4 . "							(-4 . "&") (70 . 112)
					(-4 . "NOT>")
				(-4 . "AND>")
				(-4 . "						(0 . "LWPOLYLINE")
				(-4 . "AND>")
			(-4 . "OR>"))
		)
	nbr 0
	n 0
)
(cond
	(jspl
		(initget 5)
		(setq tol
			(getdist "\nDonner l'inter-distance minimale a conserver: ")
		)
		(if (zerop (getvar "WORLDUCS")) (command "_.ucs" "_save" "lxpedit"))
		(command "_.zoom" "_vmax")
		(prompt "\nRecherche des sommets concernés en cours ...\\")
		(repeat (sslength jspl)
			(setq ent_sel (ssname jspl nbr) ent_nam ent_sel)
			(setq ent_dxf (entget ent_nam))
			(if (not (equal (assoc 210 ent_dxf) '(210 0.0 0.0 1.0)))
				(command "_.ucs" "_e" ent_nam)
				(command "_.ucs" "_w")
			)
			(if (eq (cdr (assoc 0 (entget ent_nam))) "POLYLINE")
			(while (/= (cdr (assoc 0 (setq ent_dxf (entget (entnext ent_nam))))) "SEQEND")
				(cond
					((or (/= (cdr (assoc 70 ent_dxf)) 1) (/= (cdr (assoc 70 ent_dxf)) 8))
						(if vrtx1
							(setq vrtx2 (cdr (assoc 10 ent_dxf))
							      lg (distance vrtx1 vrtx2)
							      vrtx1 vrtx2
							)
							(setq vrtx1 (cdr (assoc 10 ent_dxf)))
						)
						(if lg
							(setq lst_lg (cons lg lst_lg)
							      tst_vrtx (reverse (mapcar '(lambda (x) (< x tol)) lst_lg))
							)
						)
					)
				)
				(setq ent_nam (cdar ent_dxf))
				(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))
			)
			)
			(if (eq (cdr (assoc 0 (entget ent_nam))) "LWPOLYLINE")
			(progn
				(setq lst_pt (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ent_dxf)))
				(while (> (length lst_pt) 1)
					(setq lg (distance (car lst_pt) (cadr lst_pt)))
					(if lg
						(setq lst_lg (cons lg lst_lg)
						      tst_vrtx (reverse (mapcar '(lambda (x) (< x tol)) lst_lg))
						)
					)
					(setq lst_pt (cdr lst_pt))
				(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))
				)
			)
			)
			(cond
				(tst_vrtx
					(setq count 0)
					(command "_.pedit" ent_sel "_edit")
					(while (member T tst_vrtx)
						(if (nth count tst_vrtx)
							(progn
								(command "_straight")
								(command "_next")
								(while (nth count tst_vrtx)
									(command "_next")
									(setq nw (cdr (member T tst_vrtx)))
									(repeat (- (length tst_vrtx) (length (member T tst_vrtx)))
										(setq nw (cons nil nw))
									)
									(setq tst_vrtx nw)
								)
								(command "_go" "_x" "_edit")
								(setq count 0)
							)
							(progn
								(command "_next")
								(setq count (1+ count))
							)
						)
					)
					(command "_x" "_x")
 				)
			)
			(setq nbr (1+ nbr) vrtx1 nil vtrx2 nil a1 nil a2 nil lst_a nil ang nil)
		)
		(if (tblsearch "UCS" "LXPEDIT")
			(progn
				(command "_.ucs" "_restore" "lxpedit")
				(command "_.ucs" "_delete" "lxpedit")
			)
			(command "_.ucs" "_world")
		)
		(command "_.zoom" "_previous")
		(prompt
			(strcat
				"\n"
				(itoa (sslength jspl))
				" entité(s) soumises à la commande. TERMINE !"
			)
		)
	)
	(T (prompt "\nPas d'entités conformes sélectionnées..!"))
)
(setq *error* olderr)
(setvar "cmdecho" 1)
(prin1)
)

 

A corriger en mettant les bons symboles

(setq

jspl

(ssget

'((-4 . "infrieurOR")

(-4 . "infrieurAND")

(0 . "POLYLINE")

(-4 . "infrieurNOT")

(-4 . "&") (70 . 112)

(-4 . "NOTsupérieur")

(-4 . "ANDsupérieur")

(-4 . "infrieurAND")

(0 . "LWPOLYLINE")

(-4 . "ANDsupérieur")

(-4 . "ORsupérieur"))

)

nbr 0

n 0

)

[Edité le 25/3/2005 par bonuscad][Edité le 25/3/2005 par bonuscad]

 

[Edité le 25/3/2005 par bonuscad]

[Tramber]

T'embêtes pas, je te remercie.

 

Je remercie Pako aussi