Fond GRC en 2 D

[usegomme]

Voila le sujet d'origine mais pour gagner du temps je suis reparti sur la version que j'ai faite pour la 3d fgrc.lsp ce qui fait qu'il y a du superflu mais l'épaisseur est dessiné sauf si on donne une épaisseur négative, comme "d'habitude".

 

; FGRC2D.lsp version 1
;usegomme le 14-07-2009
; adaptation de FGRC.lsp en 3D
;Objet: Tracé de fonds GRC en 2D suivant NF E 81-102.

(defun c:Fgrc2d (/  DiamExt RayInt  RayCar  Ep    HtBD    HtTot
            PtIns   X0      X1      Y0      Y1      Ang1    pdir
            osm   echo    elev    rot abase adir     elint
      )
 (if (not fgrc:diamext) (setq fgrc:diamext 350 fgrc:ep 4 ))
 (command "_undo" "_be")
 (setq
   abase    (getvar "angbase")
   adir    (getvar "angdir")
   elev    (getvar "elevation")
   echo    (getvar "cmdecho")
   osm	    (getvar "osmode")
   DiamExt (getdist
      (strcat
	"\nDiametre Extérieur de la partie cylindrique ou 2 pts <"
	(rtos fgrc:diamext 2 4)
	">: "
      )
    )
 )
 (if DiamExt
   (setq fgrc:diamext DiamExt)
   (setq DiamExt fgrc:diamext)
 )
 (setvar "angbase" 0)
 (setq	Ep (getdist (strcat "\nEpaisseur de la tôle ou 2 pts <"
		    (rtos fgrc:Ep 2 4)
		    ">: "
	    )
   )
 )
 (if Ep
   (setq fgrc:ep Ep)
   (setq Ep fgrc:Ep)
 )

 (cond
   ((<= (abs ep) 2) (setq fgrc:htbd 20))
   ((<= (abs ep) 4) (setq fgrc:htbd 25))
   ((<= (abs ep) 6) (setq fgrc:htbd 40))
   ((<= (abs ep) 10) (setq fgrc:htbd 50))
   ((<= (abs ep) 12) (setq fgrc:htbd 55))
   ((<= (abs ep) 14) (setq fgrc:htbd 60))
   ((<= (abs ep) 16) (setq fgrc:htbd 65))
   ((<= (abs ep) 20) (setq fgrc:htbd 70))
   ((<= (abs ep) 22) (setq fgrc:htbd 75))
   ((<= (abs ep) 25) (setq fgrc:htbd 80))
   ((<= (abs ep) 28) (setq fgrc:htbd 90))
   ((<= (abs ep) 32) (setq fgrc:htbd 100))
   ((<= (abs ep) 35) (setq fgrc:htbd 110))
   ((<= (abs ep) 40) (setq fgrc:htbd 120))
   (t (setq fgrc:htbd 150))
 )

 (setq
   HtBD (getdist
   (strcat "\nHauteur du bord droit cylindrique ou 2 pts <"
	   (rtos fgrc:HtBD 2 4)
	   ">: "
   )
 )
 )
 (if (not HtBD)
   (setq HtBD fgrc:HtBD)
 )
 (setq
   RayCar (/ DiamExt 10.0)
   HtTot  (+ HtBD
      (abs ep)
      (- DiamExt
	 (sqrt (- (expt (- DiamExt RayCar) 2.0)
		  (expt (- (* DiamExt 0.5) (abs ep) RayCar) 2.0)
	       )
	 )
      )
   )

   PtIns  (getpoint "\nPoint d'insertion <0,0>: ")
 )
 (if (not PtIns)
   (setq PtIns '(0. 0.))
 )
 ;; z suivant élévation
 (setvar "cmdecho" 0)
				; sauve scu courant
 (command "_ucs" "_s" "tempftd")
 (if (not (zerop (getvar "cmdactive")))
   (command "_y")
 )
 (setq	pdir
 (getpoint PtIns "\n orientation du fond GRC : ")
 )
 (cond
   (pdir
    (setvar "ELEVATION" 0)
    (command "_ucs" "_zaxis" "_none" PtIns "_none" pdir)
    (command "_ucs" "_x" (angtos (/ pi 2) (getvar "AUNITS") 16))
    (command "_ucs" "_y" (angtos pi (getvar "AUNITS") 16))
    (setq PtIns '(0. 0. 0.))
   )
   (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 "angdir" 0)(setvar "angbase" 0)
 (setq
   X0 (- (car PtIns) (* DiamExt 0.5))
   X1 (+ (car PtIns) (* DiamExt 0.5))
   Y0 (- (+ (cadr PtIns) HtTot) DiamExt (abs ep))
   Y1 (+ (cadr PtIns) HtBD)
 )

 (setvar "OSMODE" 0)
 (cond ((> ep 0)
  (command "_.PLINE" 
   (list (- X1 ep) (nth 1 PtIns))
   (list (- X1 ep) Y1)
   "_A" "_CE" ; Arc défini par son centre
   (list (- X1 RayCar Ep) Y1)
   "_A" ; Angle...
   (setq Ang1 (/ (* 180 (angle (list (nth 0 PtIns) Y0) (list (- X1 RayCar Ep) Y1))) pi))
   "_CE"
   (list (nth 0 PtIns) Y0)
   "_A" ; Angle...
   (- 180 (* 2 Ang1))
   "_CE"
   (list (+ X0 RayCar Ep) Y1)
   "_A" ; Angle...
   Ang1
   "_L" ; Ligne...
   (list (+ X0 ep) (nth 1 PtIns))
   "" ; termine la polyligne
  )
  (command "_change" "_l" "" "_pr" "_lt" "cache" "")	 
  (setq elint (entlast))	 
 )	
)

 (command "_.PLINE" 
   (list X1 (nth 1 PtIns))
   (list X1 Y1)
   "_A" "_CE" ; Arc défini par son centre
   (list (- X1 RayCar (abs Ep)) Y1)
   "_A" ; Angle...
   (setq Ang1 (/ (* 180 (angle (list (nth 0 PtIns) Y0) (list (- X1 RayCar (abs Ep)) Y1))) pi))
   "_CE"
   (list (nth 0 PtIns) Y0)
   "_A" ; Angle...
   (- 180 (* 2 Ang1))
   "_CE"
   (list (+ X0 RayCar (abs Ep)) Y1)
   "_A" ; Angle...
   Ang1
   "_L" ; Ligne...
   (list X0 (nth 1 PtIns))
   "_C" ; Ferme la polyligne
 )

 (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")
 )
 (setvar "angdir" adir)(setvar "angbase" abase)
 (setvar "OSMODE" osm)
 (setvar "ELEVATION" elev)
 (command "_undo" "_e")
 (setvar "CMDECHO" echo)
 (princ)
)


(prompt " FGRC2D.lsp chargé.")
(prompt
 "\nTapez FGRC2D pour dessiner un fond GRC en 2D suivant NF E 81-102."
)
(princ)