Fond Elliptique en 2D

[usegomme]

Encore une reprise , le sujet d'origine .

Mais comme pour FGRC2D , je suis reparti de la version 3D que j'ai déjà fait . Et toujours pareil si la valeur d'épaisseur est négative ,celle-ci n'est pas dessinée.

 

;FE2D.lsp  Version 1
;usegomme  le 14-07-2009
;dessine un fond ELLIPTIQUE en 2D suivant NF E 81-103

(defun erreurfellip (msg)
 (setvar "angdir" adir)(setvar "angbase" abase)(setvar "ELEVATION" elev)
 (setvar "OSMODE" osm)(setvar "plinewid" pw)(setvar "CMDECHO" echo)
 (setq *error* m:err m:err nil) (princ)
)

(defun c:FE2D (/ abase adir aun elv echo osm  pw
                   diamext ep htbd ptins pdir rot
	    h2 erreurfellip
	  )
 (setq m:err *error* *error* erreurfellip)
 (if (not fellip:diamext) (setq fellip:diamext 250 fellip:ep 4 ))
 (command "_undo" "_be")
 (setq
   abase   (getvar "angbase")
   adir    (getvar "angdir")
   aun     (getvar "aunits")
   elev    (getvar "elevation")
   echo    (getvar "cmdecho")
   osm	    (getvar "osmode")
   pw      (getvar "plinewid")
 ) 
 (setvar "cmdecho" 0)(setvar "angbase" 0)(setvar "angdir" 0)(setvar "aunits" 0)
 (setq
   DiamExt (getdist
      (strcat"\nDiametre Extérieur de la partie cylindrique ou 2 pts <"
	(rtos fellip:diamext 2 4)
	">: "
      )
    )
 )
 (if DiamExt (setq fellip:diamext DiamExt) (setq DiamExt fellip:diamext))
  
 (setq	Ep (getdist (strcat "\nEpaisseur de la tôle ou 2 pts <"
		    (rtos fellip:Ep 2 4)
		    ">: "
	    )
   )
 )
 (if Ep (setq fellip:ep Ep) (setq Ep fellip:Ep))
 (cond
   ((<= (abs ep)  6) (setq fellip:htbd 40))
   ((<= (abs ep)  10) (setq fellip:htbd 50))
   ((<= (abs ep)  12) (setq fellip:htbd 56))
   ((<= (abs ep)  14) (setq fellip:htbd 60))
   ((<= (abs ep)  16) (setq fellip:htbd 65))
   ((<= (abs ep)  20) (setq fellip:htbd 70))
   ((<= (abs ep)  22) (setq fellip:htbd 75))
   ((<= (abs ep)  25) (setq fellip:htbd 80))
   ((<= (abs ep)  28) (setq fellip:htbd 90))
   ((<= (abs ep)  32) (setq fellip:htbd 100))
   ((<= (abs ep)  35) (setq fellip:htbd 110))
   ((<= (abs ep)  40) (setq fellip:htbd 120))
   ((<= (abs ep)  60) (setq fellip:htbd 130))
   ((<= (abs ep)  70) (setq fellip:htbd 140))
   (t (setq fellip:htbd 150))
 )

 (setq HtBD (getdist (strcat "\nHauteur du bord droit cylindrique ou 2 pts <" (rtos fellip:HtBD 2 4) ">: "))
 )
 (if (not HtBD) (setq HtBD fellip:HtBD))
 (setq PtIns  (getpoint "\nPoint d'insertion <0,0>: "))
 (if (not PtIns) (setq PtIns '(0. 0.))) ;; z suivant élévation
 	; sauve scu courant
 (command "_ucs" "_s" "tempftd")
 (if (not (zerop (getvar "cmdactive"))) (command "_y"))
 (initget "Rotation")
 (setq	pdir (getpoint PtIns "\n Orientation du fond ELLIPTIQUE ou : "))
 (if (= pdir "Rotation") (setq pdir nil))
 (cond
   (pdir
    (setvar "ELEVATION" 0)
    (command "_ucs" "_zaxis" "_none" PtIns "_none" pdir)
    (command "_ucs" "_x"  "90")    
    (command "_ucs" "_y" "180")           
    (setq PtIns '(0. 0. 0.) rot nil)
   )
   (T
    (setq rot (getangle "\n Angle de rotation du fond GRC  <0 , suivant axe X>: " ))
    (if rot (setq rot (- rot (* 0.5 pi))) (setq rot (* 1.5 pi)))
   )
 )

 (setvar "OSMODE" 0)
 (setvar "plinewid" 0)

 (defun fellip:tde (a b / x y)
   ; trace Demi ellipse ; a= 1/2 grand diam ; b= 1/2 petit diam
  (command "_pline" (list (+ (nth 0 ptins) a) (+ htbd (nth 1 ptins))) "_a" "_s")
  (foreach x 
             '(0.98 0.96 0.87 0.75 0.6 0.45 0.3 0.0  -0.3 -0.45 -0.6 -0.75 -0.87 -0.96  -1.0)        
   (progn
    (setq x (* a x))
    (setq y (sqrt (* (expt b 2) (- 1 (/ (expt x 2) (expt a 2))))))
    (command (list (+ (nth 0 ptins) x) (+ y htbd (nth 1 ptins))))
   )
  ) 
  (command "")
 )
 
 (setq h2 (/ (- diamext (* (abs ep) 2.0)) 3.8))
 
 (cond ((> ep 0)
  (setq a (- (* 0.5 diamext) ep)) 
  (fellip:TDE a h2)                  	 
  (setq elint (entlast))
  (command "_pline" 
    (list (+ (nth 0 ptins) a) (+ htbd (nth 1 ptins)))
    (list (+ (nth 0 ptins) a) (nth 1 ptins))
    
    ""
  )
  (command "_pedit" elint "_j" "_l" "" "")
  (setq elint (entlast))
  (command "_pline" 
    (list (- (nth 0 ptins) a) (+ htbd (nth 1 ptins)))
    (list (- (nth 0 ptins) a) (nth 1 ptins))
    
    ""
  )
  (command "_pedit" elint "_j" "_l" "" "")
  (command "_change" "_l" "" "_pr" "_lt" "cache" "")	 
  (setq elint (entlast))	 
 ))	 

 (setq a (* 0.5 diamext) b (+ h2 (abs ep)))
 (fellip:TDE a b)                           
 (setq elext (entlast))
 
 (command "_pline" 
    (list (+ (nth 0 ptins) a) (+ htbd (nth 1 ptins)))
    (list (+ (nth 0 ptins) a) (nth 1 ptins))	   
    (list (- (nth 0 ptins) a) (nth 1 ptins))
    (list (- (nth 0 ptins) a) (+ htbd (nth 1 ptins)))
   ""
 )
 (command "_pedit" elext  "_j" "_l" "" "")
  
 (if rot
   (if (> ep 0)
    (command "_rotate" "_l" elint "" PtIns (angtos rot (getvar "AUNITS") 16)) 
    (command "_rotate" "_l" "" PtIns (angtos rot (getvar "AUNITS") 16))
   )  
 )
 (if pdir (command "_ucs" "_r" "tempftd"))
 (setq a nil b nil)
 (setvar "angdir" adir)(setvar "angbase" abase)
 (setvar "OSMODE" osm)(setvar "plinewid" pw)
 (setvar "ELEVATION" elev)
 (command "_undo" "_e")
 (setvar "CMDECHO" echo)
 (gc)
 (setq *error* m:err m:err nil)
 (princ)
)

(prompt " FE2d.lsp chargé.")
(prompt
 "\nTapez FE2D pour dessiner un fond ELLIPTIQUE en 2D suivant NF E 81-103."
)
(princ)