Examples Lisp for Autocad Raccord en Y assymétrique

AutoLisp

boite tracé paroi

Programme de tracé de raccords en Y assymétrique en fonction des épaisseurs.

;-------------------------------------------------------------------------------
;------------* PROGRAMME DE TRACE de Raccord en Y assymétrique
;------------------** Copyright (C) 1987-... J-P MOLINA
;-------------------------------------------------------------------------------
(defun nettoieY2()
    (setq ESup nil)(setq Einf nil)
    (setq RR nil)(setq r nil)(setq rrr nil)(setq trait nil)
    (setq p nil)(setq ang nil)(setq angd nil)
)
;-------------------------------------------------------------------------------
(defun SaisieY2()
     (setq p (list x_pt y_pt))
     (setq ang  (degrad inclin))        ;inclin
     (setq angd  (degrad angdie))
     (setq trait  ep)          ;Epaisseur du trait 
     (setq Esup Es)
     (setq Einf Ei)

(setq r Einf)
    (setq rrr (* typfte Esup))
    (cond
         ( (and (<= Esup 25.0) (> Einf (* 0.6666 Esup))) ;test1
             (progn (setq RR (+ r Einf) )               ;res1
                    (SqueletteY21)
             )
         )
         ( (or (> Esup 25.0) (<= Einf (* 0.6666 Esup)));test2
            (progn(setq RR (* 0.5 (+ Esup (* 3.0 Einf))) );res2
                  (SqueletteY22)
            )
         )
    )
)
;-------------------------------------------------------------------------------
(defun SqueletteY21(/ cc pp0 pp1 pp2 p1 p2 q0 q1 q2 q3 q4 q5 q6
                          s0 s1 s2 s3 s4 s5 s6 tet tantet X xx)
     (setq p1 (polar p (+ ang (/ pi 2.0)) (+ rrr 5.0 (/ Einf 2.0))) )
     (setq p2 (polar p (- ang (/ pi 2.0)) (+ rrr 5.0 (/ Einf 2.0))) )
     (setq q1 (polar p1 (+ ang pi) Esup) )
     (setq s1 (polar p2 (+ ang pi) Esup) )
     (setq s2 (polar s1 (+ ang (/ pi 2.0)) 5.0 ) )
     (setq q2 (polar q1 (- ang (/ pi 2.0)) 5.0 ) )
     (setq s0 (polar s2 (+ ang (/ pi 2.0)) rrr ) )
     (setq q0 (polar q2 (- ang (/ pi 2.0)) rrr ) )
     (setq q3 (polar q0 (+ ang pi) rrr ) )
     (setq s3 (polar s0 (+ ang pi) rrr ) )
     (setq X (+ Esup (* 2.0 Einf) ) )
     (setq tet (- (/ pi 4.0) (/ angd 2.0) ))
     (setq tantet (/ (sin tet) (cos tet) ))
     (setq xx (* (+ r (/ Einf 2.0)) tantet))
     (setq pp0 (polar p (+ ang pi) (- (+ Esup X) xx) ) )
     (setq q4 (polar pp0 (+ ang (/ pi 2.0)) (/ Einf 2.0) ) )
     (setq s4 (polar pp0 (- ang (/ pi 2.0)) (/ Einf 2.0) ) )
     (setq pp1 (polar pp0 (+ ang pi) xx ) )
     (setq pp2 (polar pp1 (+ ang angd (/ pi 2.0)) xx ) )
     (setq q5 (polar pp2 (+ ang angd) (/ Einf 2.0) ) )
     (setq s5 (polar pp2 (+ ang angd pi) (/ Einf 2.0) ) )
     (setq q6 (polar q5 (+ ang angd (/ pi 2.0)) 5.0 ) )
     (setq s6 (polar s5 (+ ang angd (/ pi 2.0)) 5.0 ) )
     (setq cc (polar q4 (+ ang (/ pi 2.0)) r))

(Supp_echo)
     (Dess_Y21)
)
;-------------------------------------------------------------------------------
(defun SqueletteY22(/ cc cc1 pp0 pp1 p1 p2 qq q0 q1 q2 q3 q4 q5 q6
                      k s0 s1 s2 s3 s4 s5 s6 cc2 cc3 tet tantet
                      beta ctanaf gam tangam X xx yy yyy)
     (setq beta (atan 0.1))
     (setq tet (+ (/ pi 4.0) (/ beta 2.0) ))
     (setq tantet (/ (sin tet) (cos tet) )) 
     (setq ctanaf (/ (cos angd) (sin angd) ))
     (setq X (+ Esup (* 2.0 Einf) ))
     (setq k (- (* 0.25 (+ Esup Einf)) (* 0.1 X) ))
     (setq yyy (/ rrr tantet) )

(setq gam (+ (/ pi 4.0) (/ (- angd beta) 2.0) ))
     (setq tangam (/ (sin gam) (cos gam) ))
     (setq xx (/ (- (/ Einf (* 2.0 (sin angd)) ) k)
                 (+ 0.1 ctanaf)
              )
     )
     (setq yy (+ k (* 0.1 xx) ))
     (setq p1 (polar p (+ ang (/ pi 2.0)) (+ rrr 5.0 (* (+ Esup Einf) 0.25)) )) 
     (setq p2 (polar p (- ang (/ pi 2.0)) (+ rrr 5.0 (* (+ Esup Einf) 0.25)) )) 
     (setq q1 (polar p1 (+ ang pi) Esup) )
     (setq s1 (polar p2 (+ ang pi) Esup) )
     (setq s2 (polar s1 (+ ang (/ pi 2.0)) 5.0 ) )
     (setq q2 (polar q1 (- ang (/ pi 2.0)) 5.0 ) )
     (setq s0 (polar s2 (+ ang (/ pi 2.0)) yyy ) )  ; … voir
     (setq q0 (polar q2 (- ang (/ pi 2.0)) yyy ) )
     (setq q3 (polar q0 (+ ang pi beta) yyy ) )
     (setq s3 (polar s0 (+ ang (- pi beta)) yyy ) )
     (setq pp1 (polar p (+ ang pi) (+ X Einf) ) )
     (setq pp0 (polar pp1 ang xx) )
     (setq qq (polar pp0 (+ ang (/ pi 2.0)) yy ) )
     (setq q4 (polar qq (+ ang beta) (/ r tangam) ) )
     (setq q5 (polar qq (+ ang angd (/ pi 2.0)) (/ r tangam) ) )
     (setq q6 (polar q5 (+ ang angd (/ pi 2.0)) 5.0 ) )
     (setq s6 (polar q6 (+ ang angd pi) Einf ) )
     (setq s5 (polar s6 (+ ang (- angd (/ pi 2.0))) 5.0 ) )
     (setq cc (polar q5 (+ ang angd) r))
     (setq cc1 (polar s5 (+ ang angd) RR))
     (setq s4 (polar cc1 (- (+ ang (/ (* 3.0 pi) 2.0)) beta) RR ) )
     (setq cc2 (polar q2 (+ ang pi) rrr))
     (setq cc3 (polar s2 (+ ang pi) rrr))
     (Supp_echo)
     (Dess_Y22)
)
;-------------------------------------------------------------------------------
(defun Dess_Y21()
    (init)
    ;------------****
    (command "POLYLIGN" p2 "LA" (abs trait) "" p1 "")
    (command "POLYLIGN" q6 "LA" (abs trait) "" q5
                            "a" "ce" cc q4 "LI" q3
                            "a" "a" 90 q2
                            "LI" q1 "")
    (command "POLYLIGN" s6 "LA" (abs trait) "" s5
                            "a" "ce" cc s4 "LI" s3 "")
    (command "POLYLIGN" s1 "LA" (abs trait) "" s2
                            "a" "a" 90 s3 "")
)
;-------------------------------------------------------------------------------
(defun Dess_Y22()
     (init)
    ;------------****
    (command "POLYLIGN" p2 "LA" (abs trait) "" p1 "")
    (command "POLYLIGN" q6 "LA" (abs trait) "" q5
                            "a" "ce" cc q4 "LI" q3
                            "a" "ce" cc2 q2
                            "LI" q1 "")
    (command "POLYLIGN" s6 "LA" (abs trait) "" s5
                            "a" "ce" cc1 s4 "LI" s3 "")
    (command "POLYLIGN" s1 "LA" (abs trait) "" s2
                            "a" "ce" cc3 s3 "")
)
;-------------------------------------------------------------------------------
;------------------------*** PROGRAMME PRINCIPAL -------------------------------
(defun C:RaccY2()
    (nettoieY2)
    (prompt "\n*** raccord en Y assymétrique **(C) JP MOLINA ***")
    (paroi_dlg "0" "icoparoi(Y2)" )   ;desactive choix fonte
    (if (/= sortie 1)
     (progn
          (SaisieY2)
          (Deplac)
          (Remet_echo)   
     )
    )
    (nettoieY2)
    (princ)
)
;-------------------------------------------------------------------------------

Page de Jean-Paul Molina....

Subjects

Resources

C.A.D.

Langages

Flash

Systems

Social Networks

AutoLisp