Polyligne : Suppr. 2 points sur 3

[Azerty]

Je suis allergique aux SPLINES.

Donc hop, Splines --> enregistrement dxf ---> polyligne.

 

Inconvénient majeur : une multitude de points.

 

Existe-il un moyen de "simplifier" la polyligne, c'est-à-dire de supprimer 2 points sur 3, quite à ensuite lisser.

 

[didier]

hello,

si tu fait çà, tu n'auras pas la même géométrie des objets.

Quelle est la précision que tu recherches ?

ciao

 

[Azerty]

En y réfléchissant je réalise que ne laisser qu'un point sur 3 n'est pas une bonne idée.

En ligne droite (ou courbe légère on va dire) on peut diminuer le nbr de points par au moins 5 mais dans certains virages il est vrai qu'il en faut suffisement pr rester cohérant.

 

Donc je sais pas si c fesable. (n'importe quelle idée est la bienvenue, même si ca ne m'aide que partiellement)

 

C'est surtout pour des routes/carrefours giratoires donc une précision de .. ?? 0.50m ou 0.20m ; je sais pas trop en fait. Il faudrait que je test si qqun a une idée de commande.

 

 

D'avance Merci. (d'autant plus merci que je vous embête bcp en ce moment ;))

 

[bonuscad]

Salut,

 

Pour convertir des spline en polylignes, il y a la routine S2P.lsp de:

;;CADALYST 12/03 AutoLISP Solutions SPLINE-TO-PLINE.LSP

;;© 2003 Tony Hotchkiss

 

pour linéariser cette polyligne je te propose ma routine, si celle ci peut faire l'affaire (elle vaut ce qu'elle vaut)

Bon courage! ;)

 

(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 . "

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

(-4 . "NOT>")

(-4 . "AND>")

(-4 . "OR>"))

)

nbr 0

n 0

)

(cond

(jspl

(setq tol

(getangle

(strcat

"\nAppliquer la linéarisation aux sommets dont l'angle intérieur est > à ?<"

(angtos (angtof "179.0" 0))

">: "

)

)

)

(if (not tol) (setq tol (angtof "179.0" 0)))

(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

(progn

(setq vrtx2 (cdr (assoc 10 ent_dxf)))

(if a1

(setq a2 (angle vrtx1 vrtx2) ang (- a2 a1) a1 (+ a2 pi))

(setq a1 (angle vrtx2 vrtx1))

)

(setq vrtx1 vrtx2)

)

(setq vrtx1 (cdr (assoc 10 ent_dxf)))

)

(if ang

(progn

(if (< ang 0.0) (setq ang (abs (+ (* 2 pi) ang))))

(if (> ang pi) (setq ang (abs (rem (- (* 2 pi) ang) pi))))

(setq lst_a (cons ang lst_a))

(setq tst_vrtx (reverse (mapcar '(lambda (x) (> x tol)) lst_a)))

)

)

)

)

(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

ent_nam (entget ent_nam)

nbs (cdr (assoc 90 ent_nam))

cnt 0

lst_pt nil

)

(while (< cnt nbs)

(cond

((/= (cdr (assoc 70 ent_nam)) 1)

(if (= (caar ent_nam) 10)

(setq

lst_pt (cons (cdar ent_nam) lst_pt)

cnt (1+ cnt)

)

)

(setq ent_nam (cdr ent_nam))

)

)

)

(while (> (length lst_pt) 1)

(if a1

(setq a2 (angle (car lst_pt) (cadr lst_pt)) ang (- a2 a1) a1 (+ a2 pi))

(setq a1 (angle (cadr lst_pt) (car lst_pt)))

)

(if ang

(progn

(if (< ang 0.0) (setq ang (abs (+ (* 2 pi) ang))))

(if (> ang pi) (setq ang (abs (rem (- (* 2 pi) ang) pi))))

(setq lst_a (cons ang lst_a))

(setq tst_vrtx (mapcar '(lambda (x) (> x tol)) lst_a))

)

)

(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 "_.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)

)

[Azerty]

Désolé pour cette réponse "tardive", mais z'inquitez pas, j'ai pas oublié ce sujet ;)

 

• J'ai ce message quand je charge la routine :

erreur: cdrs supplémentaire dans la paire pointée en entrée

 

• Et celui ci quand je tape (lxperr) :

nombre d'arguments insuffisants

 

Comment puis-je y remédier ?

 

[bonuscad]

Salut,

 

Effectivement il y a eu un problème lors du copier-coller: les symbole '<' ont étés interprétés (je suppose par le BBCode) et ne figure plus dans le message.

 

2 Solutions tu pourras trouver dans la zone téléchargement free "Bonuscad.zip" et extraire cette routine.

 

Soit tu me donne ton adresse pour envoi.

 

Voili voilou ;)