Examples Lisp for Autocad 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 (1er type)
;--------------------* Copyright (C) 1987-... J-P MOLINA
;-------------------------------------------------------------------------------
(defun nettoieT1()
    (setq messT1 nil)(setq defT1 nil)(setq ESup nil)(setq Einf nil)
    (setq RR nil)(setq r nil)(setq trait nil)
    (setq p nil)(setq ang nil)
)
;-------------------------------------------------------------------------------
(defun SaisieT1()
     (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
                  (SqueletteT11)
           )
         )
         ( (or (> Esup 25.0) (<= Einf (* 0.6666 Esup)));test2
           (progn (setq r (* typfte Esup) )     ;res2
                  (setq RR (* 10.0 Esup) )
                  (SqueletteT12)
           )
         )
    )
)
;-------------------------------------------------------------------------------
(defun SqueletteT11(/ p1 q q0 q1 q2 q3 q4)
     (setq p1 (polar p ang (+ (* 0.5 Einf) 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 q4 (polar q3 (+ ang (/ pi 2.0)) 5.0))
     (setq q (polar p (+ ang (/ pi 2.0))  (+ Esup r 5.0)))

(Supp_echo)
     (Dess_T11)
)
;-------------------------------------------------------------------------------
(defun SqueletteT12(/ pp p1 q q1 q2 q3 q4 q0 q3a q3b q2a q2b delta1
                         delta2 alfa alfa2 beta delta3)
     (setq pp (polar p ang (* 0.5 Einf) ))
     (setq q0 (polar pp (+ ang (/ pi 2.0)) Esup ))
     (setq alfa (atan 0.1))
     (setq delta1 (* 0.25 (- Esup Einf)) )
     (setq q2 (polar q0 ang delta1 ))
     (setq alfa2 (* 0.5 (atan 0.1)) )
     (setq beta (+ alfa2 (/ pi 4.0) ))
     (setq delta2 (* r (/ (sin beta) (cos beta)) ))
     (setq q2b (polar q2 ang delta2))
     (setq q1 (polar q2b ang 5.0))
     (setq p1 (polar q1 (- ang (/ pi 2.0)) Esup))
     (setq q2a (polar q2 (+ ang (* 2.0 beta)) delta2 ))
     (setq q3 (polar q0 (+ ang (/ pi 2.0)) (* 10.0 delta1) ))
     (setq delta3 (* RR (/ (sin alfa2) (cos alfa2))) )
     (setq q3a (polar q3 (+ ang (/ pi 2.0)) delta3))
     (setq q4 (polar q3a (+ ang (/ pi 2.0)) 5.0))
     (setq q (polar q4 (+ ang pi) (* 0.5 Einf) ))
     (setq q3b (polar q3 (+ (- ang (/ pi 2.0)) alfa) delta3))

(Supp_echo)
     (Dess_T12)
)
;-------------------------------------------------------------------------------
(defun Dess_T11()
    (init)
    ;---------------**
    (command "POLYLIGN" p "LA" (abs trait) "" p1 "")
    (command "POLYLIGN" q4 "LA" (abs trait) "" q3
                            "a" "a" +90 q2 "LI" q1 "")

;(command "MIROIR" (ssget "X" '((0 . "POLYLINE" ) (8 . "RLT")) ) "" p q "")
    (setq ss1 (ssget "X" (list (cons 8 "RLT" ) )) )
    (command "MIROIR" ss1 "" p q "")
    (setq ss1 nil)   ; libère la mémoire
)
;-------------------------------------------------------------------------------
(defun Dess_T12()
    (init)
    ;---------------**
    (command "POLYLIGN" p "LA" (abs trait) ""  p1 "")
    (command "POLYLIGN" q4 "LA" (abs trait) "" q3a
                        "a" "r" RR q3b
                        "LI" q2a
                        "a" "r" r q2b "LI" q1 "")
    ;(command "MIROIR" (ssget "X" '((0 . "POLYLINE" ) (8 . "RLT")) ) "" p q "")
    (setq ss1 (ssget "X" (list (cons 8 "RLT" ) )) )
    (command "MIROIR" ss1 "" p q "")
    (setq ss1 nil)   ; libère la mémoire
)
;-------------------------------------------------------------------------------
;-------------------------*** PROGRAMME PRINCIPAL ------------------------------
(defun C:RaccT1()
    (nettoieT1)
    (prompt "\n----- raccord en T **(C) JP MOLINA --")
    (paroi_dlg "2" "icoparoi(T1)" )   ;desactive diedre

(if (/= sortie 1)
          (progn
               (SaisieT1)
               (Deplac)
               (Remet_echo)
          )
    )
    (nettoieT1)
    (princ)
)
;-------------------------------------------------------------------------------

Page de Jean-Paul Molina

Subjects

Resources

C.A.D.

Langages

Flash

Systems

Social Networks

AutoLisp