Spline en 2 points

Topheur · le 27 septembre 2017

Bonjour à tous et à toutes :)

Encore une fois, j'ai besoin des maitres du lisp sinon je vais devenir chauve à force de me tirer les cheveux <img src='http://cadxp.com/public/style_emoticons/<#EMO_DIR#>/laugh.gif' class='bbc_emoticon' alt=':(rires forts):' />

Je suis à la recherche d'un lisp pour tracer une spline entre 2 points (ou un arc mais j'ai parcouru la toile et avec deux points début/fin ce n'est pas possible de tracer un arc).

Du coup, je décide de remplacer l'arc par une spline et je tombe sur ce post :

http://cadxp.com/topic/32138-splines-automatiques/

Malheureusement les liens sont mort.

J'ai également trouver ce lisp qui serait encore mieux mais je ne veux pas choisir des blocs mais des clics. Le problèmes c'est que là c'est du très haut niveau pour moi <img src='http://cadxp.com/public/style_emoticons/<#EMO_DIR#>/laugh.gif' class='bbc_emoticon' alt=':(rires forts):' />

(defun l-coor2l-pt (lst flag / )
 (if lst
   (cons
     (list
       (car lst)
       (cadr lst)
       (if flag
         (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst))
         (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0)
       )
     )
     (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
   )
 )
)
(defun c:dyn_pieuvre ( / js dxf_cod mod_sel n lremov ename l_pt l_pr key alpha ori1 tg1 tg2)
 (princ "\nChoix d'un objet modèle pour le filtrage: ")
 (while
   (null
     (setq js
       (ssget "_+.:E:S"
         (list
           '(0 . "*LINE,POINT,ARC,CIRCLE,ELLIPSE,INSERT")
           (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
           (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
         )
       )
     )
   )
   (princ "\nCe n'est pas un objet valable pour cette fonction!")
 )
 (vl-load-com)
 (setq dxf_cod (entget (ssname js 0)))
 (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov))))
   (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
 )
 (initget "Unique Tout Manuel _Single All Manual")
 (if (eq (setq mod_sel (getkword "\nMode de sélection filtrée, choix [unique/Tout/Manuel]<Manuel>: ")) "Single")
   (setq n -1)
   (if (eq mod_sel "All")
       (setq js (ssget "_X" dxf_cod) n -1)
       (setq js (ssget dxf_cod) n -1)
   )
 )
 (repeat (sslength js)
   (setq ename (vlax-ename->vla-object (ssname js (setq n (1+ n)))))
   (setq l_pr (list 'StartPoint 'EndPoint 'Center 'InsertionPoint 'Coordinates 'FitPoints))
   (foreach n l_pr
     (if (vlax-property-available-p ename n)
       (setq l_pt
         (if (or (eq n 'Coordinates) (eq n 'FitPoints))
           (append
             (if (eq (vla-get-ObjectName ename) "AcDbPolyline")
               (l-coor2l-pt (vlax-get ename n) nil)
               (if (and (eq n 'FitPoints) (zerop (vlax-get ename 'FitTolerance)))
                 (l-coor2l-pt (vlax-get ename 'ControlPoints) T)
                 (l-coor2l-pt (vlax-get ename n) T)
               )
             )
             l_pt
           )
           (cons (vlax-get ename n) l_pt)
         )
       )
     )
   )
 )
 (cond
   (l_pt
     (while (and (setq key (grread T 4 0)) (/= (car key) 3))
       (redraw)
       (cond
         ((eq (car key) 5)
           (foreach n l_pt
             (grdraw (trans n 0 1) (cadr key) 3)
           )
         )
       )
     )
     (if (eq (car key) 3) 
       (foreach n l_pt
         (setq alpha (angle (trans n 0 1) (cadr key)))
         (cond
           ((and (>= alpha (* pi 0.25)) (< alpha (* pi 0.5)))
             (setq ori1 pi)
           )
           ((and (>= alpha (* pi 0.5)) (< alpha (* pi 0.75)))
             (setq ori1 0.0)
           )
           ((and (>= alpha (* pi 0.75)) (< alpha pi))
             (setq ori1 (* pi 1.5))
           )
           ((and (>= alpha pi) (< alpha (* pi 1.25)))
             (setq ori1 (* pi 0.5))
           )
           ((and (>= alpha (* pi 1.25)) (< alpha (* pi 1.5)))
             (setq ori1 0.0)
           )
           ((and (>= alpha (* pi 1.5)) (< alpha (* pi 1.75)))
             (setq ori1 pi)
           )
           ((and (>= alpha (* pi 1.75)) (< alpha (* pi 2)))
             (setq ori1 (* pi 0.5))
           )
           (T (setq ori1 (* pi 1.5)))
         )
         (if (and (>= alpha 0) (< alpha pi))
           (setq tg2 (polar (cadr key) (* pi 0.5) (distance (trans n 0 1) (cadr key))))
           (setq tg2 (polar (cadr key) (* pi 1.5) (distance (trans n 0 1) (cadr key))))
         )
         (setq tg1 (polar (trans n 0 1) ori1 (distance (trans n 0 1) (cadr key))))
         (command "_.spline" "_none" (trans n 0 1) "_none" (cadr key) "" "_none" tg1 "_none" tg2)
       )
     )
     (redraw)
   )
 )
 (prin1)
)

Voilà, vous savez tous, merci de votre aide.

(gile) · le 27 septembre 2017

Voilà, vous savez tous, merci de votre aide.

Si tu relis bien le sujet que tu as mis en lien (notamment la réponse #9 de didier) tu devrais comprendre qu'on est loin de "savoir tous" (ou plutôt "savoir tout").

Géométriquement, deux points définissent une droite (ou un segment de droite). Pour un arc ou une spline, il faut au minimum une donnée de plus...

(gile) · le 27 septembre 2017

Un petit truc vite fait qui ne dessine pas un spline mais une polyligne avec une ondulation.

On peut modifier la courbure en changeant la valeur des groupes 42 (0. => segment droit, 1.0 => demi cercle).

(defun c:TOPHEUR (/ p1 p2 zdir elev pmid)
 (and
   (setq p1 (getpoint "\nPremier point: "))
   (setq p2 (getpoint p1 "\nPremier point: "))
   (setq zdir (trans '(0. 0. 1.) 1 0 T)
  elev (caddr p1)
  pmid (mapcar '(lambda (a B) (/ (+ a B) 2.)) p1 p2)
   )
   (entmakex
     (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 3)
(cons 70 0)
(cons 38 elev)
(cons 10 (trans p1 1 zdir))
(cons 42 -0.25)
(cons 10 (trans pmid 1 zdir))
(cons 42 0.25)
(cons 10 (trans p2 1 zdir))
(cons 210 zdir)
     )
   )
 )
 (princ)
)

Topheur · le 27 septembre 2017

Un petit truc vite fait qui ne dessine pas un spline mais une polyligne avec une ondulation.

On peut modifier la courbure en changeant la valeur des groupes 42 (0. => segment droit, 1.0 => demi cercle).

(defun c:TOPHEUR (/ p1 p2 zdir elev pmid)
 (and
   (setq p1 (getpoint "\nPremier point: "))
   (setq p2 (getpoint p1 "\nPremier point: "))
   (setq zdir (trans '(0. 0. 1.) 1 0 T)
  elev (caddr p1)
  pmid (mapcar '(lambda (a B) (/ (+ a B) 2.)) p1 p2)
   )
   (entmakex
     (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 3)
(cons 70 0)
(cons 38 elev)
(cons 10 (trans p1 1 zdir))
(cons 42 -0.25)
(cons 10 (trans pmid 1 zdir))
(cons 42 0.25)
(cons 10 (trans p2 1 zdir))
(cons 210 zdir)
     )
   )
 )
 (princ)
)

Bonsoir Gile,

Merci pour ce premier jet.

Le seul soucis c'est qu'avec 2 arcs, si je veux déplacer un point c'est beaucoup moins jolie (ça ne trace pas une polyligne mais 2 arcs).

Ce que je ne comprends pas c'est que le lisp trace deux arcs sans connaitre le milieu (défini par calcul) donc pourquoi ne sait il pas me tracer un arc et définir son point milieu (p2 divisé par 2 et comme on est sur le même plan que p1, pour la hauteur, on peut la définir dans le lisp) ?

Ou passer par un autre point ?

De plus sur le lisp que j'ai mis dans mon post, il ne connait que 2 points (le point d'insertion d'un bloc et un 2e point utilisateur) et il trace quand même une spline (ou je me trompe).

Merci d'éclairer ma lanterne

(gile) · le 27 septembre 2017

Je ne sais pas si maintenant tu as tout dit, mais tu en déjà dit un peu plus en parlant de grips à déplacer ultérieurement.

Une spline avec 1 grip intermédiaire :

(defun c:TOPHEUR (/ p1 p2)
 (if
   (and
     (setq p1 (getpoint "\nPremier point: "))
     (setq p2 (getpoint p1 "\nDernier point: "))
   )
    (command "_.spline"
      "_non"
      p1
      "_non"
      (polar p1 (+ (angle p1 p2) 0.25) (* 0.5 (distance p1 p2)))
      "_non"
      p2
      ""
      ""
      ""
    )
 )
 (princ)
)

Une spline avec 2 grips intermédiaires :

(defun c:TOPHEUR (/ p1 p2 p3 p4 p5 di)
 (if
   (and
     (setq p1 (getpoint "\nPremier point: "))
     (setq p4 (getpoint p1 "\nDernier point: "))
   )
    (progn
      (setq di	(/ (distance p1 p4) 4)
     p2	(polar p1 (+ (angle p1 p4) 0.25) di)
     p3	(polar p4 (+ (angle p4 p1) 0.25) di)
      )
      (command "_.spline")
      (foreach p (list p1 p2 p3 p4) (command "_non" p))
      (command "" "" "")
    )
 )
 (princ)
)

Une spline avec 3 grips intermédiaires :

(defun c:TOPHEUR (/ p1 p2 p3 p4 p5 di)
 (if
   (and
     (setq p1 (getpoint "\nPremier point: "))
     (setq p5 (getpoint p1 "\nDernier point: "))
   )
    (progn
      (setq di	(/ (distance p1 p5) 4)
     p2	(polar p1 (+ (angle p1 p5) 0.25) di)
     p3	(polar p1 (angle p1 p5) (* 2. di))
     p4	(polar p5 (+ (angle p5 p1) 0.25) di)
      )
      (command "_.spline")
      (foreach p (list p1 p2 p3 p4 p5) (command "_non" p))
      (command "" "" "")
    )
 )
 (princ)
)

lecrabe · le 28 septembre 2017

Hello Gilles

MERCI j'adore tes pieuvres "marseillaises" avec 1 / 2 / 3 tentacules !

Bye, lecrabe

Topheur · le 28 septembre 2017

Je ne sais pas si maintenant tu as tout dit, mais tu en déjà dit un peu plus en parlant de grips à déplacer ultérieurement.

Une spline avec 1 grip intermédiaire :

(defun c:TOPHEUR (/ p1 p2)
 (if
   (and
     (setq p1 (getpoint "\nPremier point: "))
     (setq p2 (getpoint p1 "\nDernier point: "))
   )
    (command "_.spline"
      "_non"
      p1
      "_non"
      (polar p1 (+ (angle p1 p2) 0.25) (* 0.5 (distance p1 p2)))
      "_non"
      p2
      ""
      ""
      ""
    )
 )
 (princ)
)

Une spline avec 2 grips intermédiaires :

(defun c:TOPHEUR (/ p1 p2 p3 p4 p5 di)
 (if
   (and
     (setq p1 (getpoint "\nPremier point: "))
     (setq p4 (getpoint p1 "\nDernier point: "))
   )
    (progn
      (setq di	(/ (distance p1 p4) 4)
     p2	(polar p1 (+ (angle p1 p4) 0.25) di)
     p3	(polar p4 (+ (angle p4 p1) 0.25) di)
      )
      (command "_.spline")
      (foreach p (list p1 p2 p3 p4) (command "_non" p))
      (command "" "" "")
    )
 )
 (princ)
)

Une spline avec 3 grips intermédiaires :

(defun c:TOPHEUR (/ p1 p2 p3 p4 p5 di)
 (if
   (and
     (setq p1 (getpoint "\nPremier point: "))
     (setq p5 (getpoint p1 "\nDernier point: "))
   )
    (progn
      (setq di	(/ (distance p1 p5) 4)
     p2	(polar p1 (+ (angle p1 p5) 0.25) di)
     p3	(polar p1 (angle p1 p5) (* 2. di))
     p4	(polar p5 (+ (angle p5 p1) 0.25) di)
      )
      (command "_.spline")
      (foreach p (list p1 p2 p3 p4 p5) (command "_non" p))
      (command "" "" "")
    )
 )
 (princ)
)

Merci, plus qu'à adapter à mon code.

Sujet clos

x_all · le 29 septembre 2017

Pas mal du tout ces 3 petites fonctions...

je les garde sous le coude...

Connexion

Spline en 2 points

Messages recommandés

Topheur

(gile)

(gile)

Topheur

(gile)

lecrabe

Topheur

x_all

Forums

Naviguer

Activité

Information importante