Raccord sans joindre

[Fraid]

bonjour,

 

Je reve d'un lispounet qui qui me ferai un _fillet sans joindre

je sais bien qu'il suffit d'exploser la polyligne de faire un pedit et de redonner l'epaisseur initial...

 

merci ;)

[Patrick_35]

Salut

 

(defun c:ra(/ code1 code2 ent1 ent2 pt1 pt2 pti)

 (defun err (msg)
   (if (/= msg "Fonction annulée")
     (princ (strcat "\nErreur : " msg))
     (princ msg)
   )
   (if ent1
     (redraw (cdr (assoc -1 ent1)) 4)
   )
   (setq *error* olderr)
   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
   (princ)
 ) 

 (defun selection(ent pts / code lst pt)
   (cond
     ((eq (cdr (assoc 0 ent)) "LINE")
       (if (< (distance pts (cdr (assoc 10 ent)))
              (distance pts (cdr (assoc 11 ent))))
         (setq code 10)
         (setq code 11)
       )
     )
     ((eq (cdr (assoc 0 ent)) "LWPOLYLINE")
       (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent)))
       (if (< (distance pts (last lst)) (distance pts (car lst)))
         (setq code (list (last lst) (cadr (reverse lst))))
         (setq code (list (car lst) (cadr lst)))
       )
     )
   )
   code
 )

 (vl-load-com)
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (setq olderr *error* *error* err)
 (if (setq ent1 (car (entsel "\nSélectionner la première ligne/polyligne : ")))
   (progn
     (setq ent1 (entget ent1))
     (if (setq code1 (selection ent1 (cadr (grread T))))
       (progn
         (redraw (cdr (assoc -1 ent1)) 3)
         (if (setq ent2 (car (entsel "\nSélectionner la seconde ligne/polyligne : ")))
           (progn
             (setq ent2 (entget ent2))
             (if (setq code2 (selection ent2 (cadr (grread T))))
               (progn
                 (redraw (cdr (assoc -1 ent1)) 4)
                 (if (eq (type code1) 'INT)
                   (setq pt1 (list (cdr (assoc 10 ent1)) (cdr (assoc 11 ent1))))
                   (setq pt1 code1)
                 )
                 (if (eq (type code2) 'INT)
                   (setq pt2 (list (cdr (assoc 10 ent2)) (cdr (assoc 11 ent2))))
                   (setq pt2 code2)
                 )
                 (setq pti (trans (inters (car pt1) (cadr pt1) (car pt2) (cadr pt2) nil) 0 1))
                 (if (eq (type code1) 'INT)
                   (setq ent1 (subst (cons code1 pti) (assoc code1 ent1)    ent1))
                   (setq ent1 (subst (cons 10 pti)    (cons 10 (car code1)) ent1))
                 )
                 (entmod ent1)
                 (if (eq (type code2) 'INT)
                   (setq ent2 (subst (cons code2 pti) (assoc code2 ent2)    ent2))
                   (setq ent2 (subst (cons 10 pti)    (cons 10 (car code2)) ent2))
                 )
                 (entmod ent2)
               )
             )
           )
           (redraw (cdr (assoc -1 ent1)) 4)
         )
       )
     )
   )
 )
 (setq *error* olderr)
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (princ)
)

 

@+

[Fraid]

extraordinaire

 

je reste sans voie

 

j'espere ne pas etre le seul a profiter de ce lisp car il est genial

vraiment je le recomande

 

merci patrick car tu as du te donner du mal

ce n'est pas niveau debutant

 

[lecrabe]

 

Bonsoir

 

Merci / Excellent / Parfait !!! :) :D :cool:

 

Ce soir je fais mes emplettes au marché du Lisp de www.cadxp.com ...

 

Un seul mot : LA CLASSE

 

J'ai testé avec mes polylignes tordues / farfelues déjà utilisées pour tester un autre routine de Bonuscad et ça roule Nickel Chrome :P

 

Le Decapode "bluffé"

 

 

 

[DenisHen]

Bonsoir

 

Je n'ai pas compris, c'est un raccord sans faire joindre ?

 

On a à l'origine, deux polylignes (non parallèles) et on les raccorde en gardant deux entités polylignes ?

 

MMMmmmm intéressant... À force d'habitude, je vais très vite pour le faire... Mais je le garde... Mes collègues vont surement aprécier... Quand ils auront enfin compris q'une ligne à plusieurs sommets est une polyligne ! !

 

;)

 

Merci Patrick_35...

 

Denis...