Exemples Lisp pour Autocad (AutoLisp) Raccord en T

AutoLisp

boite tracé paroi

Programme de tracé de raccords en T en fonction des épaisseurs.

;-------------------------------------------------------------------------------
;---------------** PROGRAMME DE TRACE de Raccord en T.(3ème type)
;---------------** Copyright (C) 1987-... J-P MOLINA
;-------------------------------------------------------------------------------
(defun nettoieT3()
    (setq ESup nil)(setq Einf nil)
    (setq RR nil)(setq r nil)(setq trait nil)
    (setq p nil)(setq ang nil)
)
;-------------------------------------------------------------------------------
(defun SaisieT3()
     (setq p (list x_pt y_pt))
     (setq ang  (degrad inclin))        ;inclin
     
     (setq trait  ep)          ;Epaisseur du trait 
     (setq Esup Es)
     (setq Einf Ei)

(cond
         ( (and (<= Esup 25.0) (> Einf (* 0.6666 Esup))) ;test1
           (progn (setq r (* typfte Esup) )      ;res1
                  (SqueletteT31)
           )
         )
         ( (or (> Esup 25.0) (< Einf (* 0.6666 Esup)));test2
           (progn (setq r (* typfte Esup) )     ;res2
                  (setq RR (* 5.0 Esup) )
                  (SqueletteT32)
           )
         )
    )
)
;-------------------------------------------------------------------------------
(defun SqueletteT31(/ stock p1 q q0 q1 q2 q3 q4 pp1 qq0 qq1 qq2 qqa qqb)
     (setq p1 (polar p ang (+ (* 0.5 Esup) r 5.0)))
     (setq q1 (polar p1 (+ ang (/ pi 2.0)) Einf))
     (setq q2 (polar q1 (+ ang pi) 5.0))
     (setq q0 (polar q2 (+ ang pi) r))
     (setq q3 (polar q0 (+ ang (/ pi 2.0)) r))

(setq q (polar p (+ ang (/ pi 2.0))  (+ Esup r 5.0)))
     (setq pp1 (polar p (+ ang pi) (+ 5.0 r (/ Esup 2.0)) )) ; en fait Esup
                                              ; mais il y a eu permutation
     (setq qq1 (polar pp1 (+ ang (/ pi 2.0)) Esup))
     (setq qqb (polar qq1 ang 5.0))
     (setq qq0 (polar qqb ang r))
     (setq qqa (polar qq0 (+ ang (/ pi 2.0)) r))
     (setq qq2 (polar qqa (+ ang (/ pi 2.0)) 5.0))
     (setq q4 (polar qq2 ang Esup)) ;modifié pour le même niveau
                                    ; + en fait Esup......
     (Supp_echo)
     (Dess_T31)
)
;-------------------------------------------------------------------------------
(defun SqueletteT32(/ pp p1 p3 q q1 q2 q3 q0 qqa qqb q2a q2b dist pp1 qq0
                      qq1 qq2 qqa1 qqb1 delta1 alfa alfa2 beta delta2)
     (setq pp (polar p ang (* 0.5 Esup)))
     (setq q (polar pp (+ ang (/ pi 2.0)) (* 0.5 (+ Esup Einf)) ))
     (setq q0 (polar pp (+ ang (/ pi 2.0)) Einf ))
     (setq alfa2 (* 0.5 (atan 0.2)) )
     (setq beta (+ alfa2 (/ pi 4.0) ))
     (setq dist (/ r (/ (sin beta) (cos beta))) )
     (setq qqa (polar q (+ ang (/ pi 2.0)) dist ))
     (setq alfa (atan 0.2))
     (setq qqb (polar q (- ang alfa) dist ))
     (setq q1 (polar qqa (+ ang (/ pi 2.0)) 5.0))
     (setq p1 (polar q1 (+ ang pi) (* 0.5 Esup) ))
     (setq delta1 (* 0.5 (- Esup Einf)) )
     (setq q2 (polar q0 ang (* 5.0 delta1) ))
     (setq delta2 (* RR (/ (sin alfa2) (cos alfa2)) ))
     (setq q2b (polar q2 ang delta2))
     (setq q3 (polar q2b ang 5.0 ))
     (setq p3 (polar q3 (- ang (/ pi 2.0)) Einf))
     (setq q2a (polar q2 (+ ang (- pi alfa)) delta2 ))

(setq pp1 (polar p (+ ang pi) (+ 5.0 r (/ Esup 2.0)) ))
     (setq qq1 (polar pp1 (+ ang (/ pi 2.0)) Esup))
     (setq qqb1 (polar qq1 ang 5.0))
     (setq qq0 (polar qqb1 ang r))
     (setq qqa1 (polar qq0 (+ ang (/ pi 2.0)) r))
     (setq qq2 (polar qqa1 (+ ang (/ pi 2.0)) 5.0))
     (setq q4 (polar qq2 ang Esup))

(Supp_echo)
     (Dess_T32)
)
;-------------------------------------------------------------------------------
(defun Dess_T31()
    (init)
    ;----------****
    (command "POLYLIGN" pp1 "LA" (abs trait) "" p1 "")
    (command "POLYLIGN" q4 "LA" (abs trait) "" q3
                            "a" "a" +90 q2 "LI" q1 "")
    (command "POLYLIGN" qq1 "LA" (abs trait) "" qqb
                            "a" "a" +90 qqa "LI" qq2 "")                       
)
;-------------------------------------------------------------------------------
(defun Dess_T32()
    (init)
    ;----------****
    (command "POLYLIGN" pp1 "LA" (abs trait) "" p3 "")
    (command "POLYLIGN" q4 "LA" (abs trait) "" qqa
                        "a" "r" r qqb
                        "LI" q2a
                        "a" "r" RR q2b "LI" q3 "")
    (command "POLYLIGN" qq1 "LA" (abs trait) "" qqb1
                            "a" "a" +90 qqa1 "LI" qq2 "")
)
;-------------------------------------------------------------------------------
;--------------------*** PROGRAMME PRINCIPAL -----------------------------------
(defun C:RaccT3()
    (nettoieT3)
    (prompt "\n*** raccord en T (3ème type) **(C) JP MOLINA -----")
    (paroi_dlg "2" "icoparoi(T3)" )   ;desactive diedre

(if (/= sortie 1) 
     (progn
          (SaisieT3)
          (Deplac)
          (Remet_echo)
     )
    )
    (nettoieT3)
    (princ)
)
;-------------------------------------------------------------------------------

Page de Jean-Paul Molina

Matières

Ressources

Conception assistée

Langages

Flash

Systèmes

Réseaux sociaux

AutoLisp