Examples Lisp for Autocad Raccord en L angle vif

AutoLisp

boite tracé paroi

Programme de tracé de raccords en L (angle vif) en fonction des épaisseurs.

;-------------------------------------------------------------------------------
;----------------    PROGRAMME DE TRACE de Raccord en L.(angle vif)
;----------------    Copyright (C) 1987-... J-P MOLINA
;-------------------------------------------------------------------------------   
(defun nettoieLvif()
    (setq ESup nil)(setq Einf nil)
    (setq RR nil)(setq r nil)(setq trait nil)
    (setq p nil)(setq ang nil)
)
;-------------------------------------------------------------------------------       
(defun SaisieLvif()
    (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 (max 4.0 (* typfte Esup)) )      ;res1
                  (SqueletteLvif1)
           )
         )
         ( (or (>= Esup 25.0) (< Einf (* 0.6666 Esup)));test2
           (progn (setq r (max 4.0 (* typfte Esup)) )     ;res2
                  (setq RR (* 5.0 Esup) )
                  (SqueletteLvif2)
           )
         )
    )
)
;--------------------------------------------------------------------------------
(defun SqueletteLvif1(/ p1 p2 q q1 q2 q3 q4)
     (setq p1 (polar p ang (+ Esup r 5.0)))
     (setq p2 (polar p (+ ang (/ pi 2.0))  (+ Einf r 5.0)))
     (setq q1 (polar p1 (+ ang (/ pi 2.0)) Einf))
     (setq q2 (polar q1 (+ ang pi) 5.0))
     (setq q (polar q2 (+ ang pi) r))
     (setq q3 (polar q (+ ang (/ pi 2.0)) r))
     (setq q4 (polar q3 (+ ang (/ pi 2.0)) 5.0))
     (Supp_echo)
     (Dess_Lvif1)
)
;------------------------------------------------------------------------------- 
(defun SqueletteLvif2(/ pp p1 p3 q q1 q2 q3 q0 qqa qqb q2a q2b dist
                         delta1 alfa alfa2 beta delta2)
     (setq pp (polar p ang 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) 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 ))
     (Supp_echo)
     (Dess_Lvif2)
)
;-------------------------------------------------------------------------------        
(defun Dess_Lvif1()
    (init)
    ;----------------
    (command "POLYLIGN" p1 "LA" (abs trait) "" p p2 "")
    (command "POLYLIGN" q4 "LA" (abs trait) "" q3
                            "a" "a" +90 q2 "LI" q1 "")
)
;-------------------------------------------------------------------------------        
(defun Dess_Lvif2()
    (init)
    ;----------------
    (command "POLYLIGN" p1 "LA" (abs trait) "" p p3 "")
    (command "POLYLIGN" q1 "LA" (abs trait) "" qqa 
                        "a" "r" r qqb 
                        "LI" q2a 
                        "a" "r" RR q2b "LI" q3 "")
)
;-------------------------------------------------------------------------------      
;------------------------** PROGRAMME PRINCIPAL -----------
(defun C:RaccLvif()
    (nettoieLvif)
    (prompt "\n-------- raccord en Lvif (C) JP MOLINA --")
    (paroi_dlg "2" "icoparoi(L2)" )   ;desactive diedre
    (if (/= sortie 1) 
        (progn 
          (SaisieLvif)
          (Deplac)
          (Remet_echo)   
        )
    )
    (nettoieLvif)
    (princ)
)
;-------------------------------------------------------------------------------

Page de Jean-Paul Molina

Subjects

Resources

C.A.D.

Langages

Flash

Systems

Social Networks

AutoLisp