Lisp Clotoïde

[philous2]

Bjr,

 

Je suis à la recherche dune routine pour calculer une clotoïde en pouvant indiquer la longueur, le rayon ou le déport il me faut 2 de ces 3 éléments pour calculer plus précisement à la façon de Piste mais sur Autocad.

Je suis tombé sur un lisp clotoïde(ci-après) mais qui calcule seulement par le pas.

Comment transformer ce lisp pour calculer soit par pas, par déport ou longueur si c'est possible.

 

Lisp Clotoïde:

 

[surligneur] (defun factor (y / )

(cond

((= 0 y) 1)

(t (* y (factor (1- y))))

)

)

(defun fact (nbr / x)

(setq x nbr)

(factor (float x))

)

(defun serie (rep / mark rp resul)

(setq

mark 1

rp rep

som 0

)

(repeat (fix (* l 10))

(setq resul (/ (expt tau rp) (* (1+ (* 2 rp)) (fact rp))))

(if (/= (rem mark 2) 0)

(setq resul (- resul))

)

(setq

som (+ resul som)

rp (+ rp 2)

mark (1+ mark)

)

)

)

(defun cloun (l / k som)

(setq

r (/ 1 l)

tau (/ l (* 2 r))

k (sqrt (* 2 tau))

)

(serie 2)

(setq x (* k (+ 1 som)))

(serie 3)

(setq

y (* k (+ (/ tau 3) som))

xm (- x (* r (sin tau)))

ym (+ y (* r (cos tau)))

dltr (- ym r)

)

)

(defun matrix (pt / t_x t_y t_z t_v t_zo nw_x nw_y nw_z)

(setq

t_x (trans '(1 0 0) 0 1 T)

t_y (trans '(0 1 0) 0 1 T)

t_z (trans '(0 0 1) 0 1 T)

t_v (trans '(0 0 0) 1 0)

t_zo (trans '(0 0 0) 0 1)

)

(setq nw_x

(+

(* (car pt) (car t_x))

(* (cadr pt) (cadr t_x))

(* (caddr pt) (caddr t_x))

(car t_v)

)

)

(setq nw_y

(+

(* (car pt) (car t_y))

(* (cadr pt) (cadr t_y))

(* (caddr pt) (caddr t_y))

(cadr t_v)

)

)

(setq nw_z

(+

(* (car pt) (car t_z))

(* (cadr pt) (cadr t_z))

(* (caddr pt) (caddr t_z))

(caddr t_v)

)

)

(list nw_x nw_y nw_z)

)

(defun c:clothoide ( / d ent_d c ent_c dxf_10 dxf_11 dxf_r dxf_m dxf_g pt_per dxf_ym dxf_dltr lg_clo a_clo l_u lst_r cnt tstd tstl choix p_inf resol_cl l x y xm ym r tau dltr lst_som )

(if (= (getvar "worlducs") 1)

(progn

(setvar "cmdecho" 0)

(setvar "blipmode" 0)

(setvar "orthomode" 0)

(setvar "osmode" (+ 16384 (rem (getvar "osmode") 16384)))

(if (= (getvar "limcheck") 1) (setvar "limcheck" 0))

(command "_.undo" "_control" "_all")

(command "_.undo" "_group")

(while (not (setq d (nentsel"\nChoix de la droite: "))))

(setq ent_d (entget (car d)))

(cond

((and (equal (assoc 210 ent_d) '(210 0.0 0.0 1.0)) (eq (cdr (assoc 0 ent_d)) "LINE"))

(while (not (setq c (nentsel"\nChoix du cercle: "))))

(setq ent_c (entget (car c)))

(cond

((and (equal (assoc 210 ent_c) '(210 0.0 0.0 1.0)) (or (eq (cdr (assoc 0 ent_c)) "CIRCLE") (eq (cdr (assoc 0 ent_c)) "ARC")))

(setq

dxf_10 (trans (cdr (assoc 10 ent_d)) 1 0)

dxf_11 (trans (cdr (assoc 11 ent_d)) 1 0)

dxf_r (cdr (assoc 40 ent_c))

dxf_m (trans (cdr (assoc 10 ent_c)) 1 0)

dxf_g (angle dxf_10 dxf_11)

pt_per

(inters

(list (car dxf_10) (cadr dxf_10))

(list (car dxf_11) (cadr dxf_11))

(list (car dxf_m) (cadr dxf_m))

(list

(car (polar dxf_m (+ (/ pi 2) dxf_g) dxf_r))

(cadr (polar dxf_m (+ (/ pi 2) dxf_g) dxf_r))

)

nil

)

dxf_ym (distance dxf_m pt_per)

dxf_dltr (- dxf_ym dxf_r)

)

(cond

((and (not (minusp dxf_dltr)) (<= dxf_dltr (* 4.0 dxf_r)))

(setq

lg_clo (sqrt (+ (* 24 dxf_dltr dxf_r) (* 6 (expt dxf_dltr 2))))

a_clo (sqrt (* lg_clo dxf_r))

)

(setq l_u (/ lg_clo a_clo))

(cond

((<= l_u (* 4 (sqrt pi)))

(cloun l_u)

(setq lst_r (mapcar '(lambda (ww) (* ww a_clo)) (list x y xm ym dltr)))

;(prompt "\nErreur commise sur Delta R (en m.) = ") (prin1 (abs (- dxf_dltr (last lst_r))))

;(prompt "\nDelta R reel : ") (prin1 (rtos dxf_dltr 2 5))

;(prompt "\nDelta R calcule : ") (prin1 (rtos (last lst_r) 2 5))

(setq cnt 0)

(while (not (equal (last lst_r) dxf_dltr 0.00001))

(setq cnt (1+ cnt))

(if (= (rem (1+ cnt) 2) 0)

(setq tstd (last lst_r) tstl lg_clo)

)

(if (= (rem cnt 2) 0)

(setq lg_clo (* (/ dxf_dltr (/ (+ tstd (last lst_r)) 2)) (/ (+ lg_clo tstl) 2)))

(setq lg_clo (* (/ dxf_dltr (last lst_r)) lg_clo))

)

(setq a_clo (sqrt (* lg_clo dxf_r)))

(setq l_u (/ lg_clo a_clo))

(cloun l_u)

(setq lst_r (mapcar '(lambda (ww) (* ww a_clo)) (list x y xm ym dltr)))

;(prompt "\nDelta R calcule : ") (prin1 (rtos (last lst_r) 2 5))

)

(setq choix (mapcar '(lambda (ww) (polar pt_per ww (caddr lst_r))) (list dxf_g (+ pi dxf_g))))

(if (> (distance (car choix) (cadr d)) (distance (cadr choix) (cadr d)))

(setq dxf_g (+ pi dxf_g))

)

(setq

p_inf (polar pt_per dxf_g (caddr lst_r))

dxf_g (+ pi dxf_g)

)

(prompt

(strcat

"\nPas de résolution de la clothoïde <"

(rtos (* 0.1 (sqrt lg_clo)) 2)

"> :"

)

)

(initget 6)

(setq resol_cl (getdist))

(if (not resol_cl) (setq resol_cl (* 0.1 (sqrt lg_clo))))

(command "_.ucs" "_new" "_3point" p_inf pt_per dxf_m)

(setq lst_som (list (matrix (list (car lst_r) (cadr lst_r) 0.0))) l (- lg_clo resol_cl))

(while (> l 0.0)

(cloun (/ l a_clo))

(setq lst_som (cons (matrix (list (* x a_clo) (* y a_clo) 0.0)) lst_som) l (- l resol_cl))

)

(setq lst_som (cons (trans (list 0.0 0.0 0.0) 1 0) lst_som))

(command "_.ucs" "_world")

(if (null (tblsearch "appid" "ID_CLOTHOIDE-BONUSCAD$2002"))

(regapp "ID_CLOTHOIDE-BONUSCAD$2002")

)

(entmake

(append

(list

'(0 . "LWPOLYLINE")

'(100 . "AcDbEntity")

(cons 8 (getvar "CLAYER"))

'(100 . "AcDbPolyline")

(cons 90 (length lst_som))

)

(mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) lst_som)

(list

(list -3

(list

"ID_CLOTHOIDE-BONUSCAD$2002"

(cons 1000 "ID_CLOTHOIDE")

(cons 1002 "{")

(cons 1040 dxf_g)

(cons 1010 p_inf)

(cons 1040 a_clo)

(cons 1040 dxf_dltr)

(cons 1040 tau)

(cons 1040 lg_clo)

(cons 1040 dxf_r)

(cons 1010 dxf_m)

(cons 1010 (matrix (list (car lst_r) (cadr lst_r) 0.0)))

(cons 1002 "}")

)

)

)

)

)

(command "_.undo" "_end")

(alert

(strcat

"\nLES ANGLES SONT EXPRIME DANS LES UNITES UTILISES"

"\n______________________________"

"\nOrientation de l'infini\t: " (angtos dxf_g (getvar "aunits") 4)

"\nOrigine clothoïde \t: X= " (rtos (car p_inf) 2 3) " Y= " (rtos (cadr p_inf) 2 3)

"\n Rayon a l'origine \t: ...infini..."

"\n Parametre A \t: " (rtos a_clo 2 3)

"\n Delta R \t: " (rtos dxf_dltr 2 3)

"\n Angle TAU \t: " (angtos tau (getvar "aunits") 4)

"\n Developpement \t: " (rtos lg_clo 2 3)

"\n Rayon du cercle \t: " (rtos dxf_r 2 3)

"\n Centre du cercle \t: X= " (rtos (car dxf_m) 2 3) " Y= " (rtos (cadr dxf_m) 2 3)

"\nFin le la clothoïde \t: X=" (rtos (car (matrix (list (car lst_r) (cadr lst_r) 0.0))) 2 3) " Y= " (rtos (cadr (matrix (list (car lst_r) (cadr lst_r) 0.0))) 2 3)

"\n______________________________"

)

)

 

)

(T

(prompt "\nLongueur de clothoïde trop importante pour être résolue")

(command "_.undo" "_end")

(command "_.u")

)

)

)

(T

(prompt "\nLa droite coupe le cercle ou ripage trop important; pas de solution .")

)

)

)

(T

(prompt "\nEntité sélectionnée n'est ni un cercle, ni un arc, ou n'est pas parallèle au SGC!")

(command "_.undo" "_end")

(command "_.u")

)

)

)

(T

(prompt "\nEntité sélectionnée n'est pas une ligne, ou n'est pas parallèle au SGC!")

(command "_.undo" "_end")

(command "_.u")

)

)

)

(prompt "\nVous n'êtes pas dans le systeme de coordonnées général ! RECTIFIEZ S.V.P")

)

(setvar "cmdecho" 1)

(prin1)

)[/surligneur]