Fond GRC 3d

usegomme · le 10 juin 2009

Salut.

Suite à la demande d'etude0 j'ai modifié FondB.lsp pour faire les fond GRC en 3d.

C'est un nouveau post car le titre du précédent n' était pas correct .

A+

;usegomme le 11-06-2009
;Version 1.1
;Fait à partir de FondB.lsp écrit par Maxence Delannoy et modifié par Yann Nicollet avec l'aide de Bonuscad et Bred
;Objet: Tracé de fonds GRC en 3D suivant NF E 81-102.

(defun c:Fgrc ( / DiamExt RayInt RayCar Ep HtBD HtTot PtIns X0 X1 Y0 Y1 Ang1 pdir contourGRC osm echo elev)
 (command "_undo" "_be")
 (setq
   elev (getvar "elevation")
   echo (getvar "cmdecho")
   osm (getvar "osmode")
   DiamExt (getreal "\nDiamètre extérieur: ")
   RayCar  (/ DiamExt 10.0)
   Ep	    (getreal "\nEpaisseur: ")
   HtBD    (getreal "\nHauteur du bord droit: ")
   HtTot   (+ HtBD
       Ep
       (- DiamExt
	  (sqrt	(- (expt (- DiamExt RayCar) 2.0)
		   (expt (- (* DiamExt 0.5) Ep RayCar) 2.0)
		)
	  )
       )
    )

  PtIns (getpoint "\nPoint d'insertion: ")
)

; 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" "90")
    (command "_ucs" "_y" "180")
    (setq PtIns '(0. 0. 0.))
   )
 )

 (setq
   X0 (- (car PtIns) (* DiamExt 0.5))
   X1 (+ (car PtIns) (* DiamExt 0.5))
   Y0 (- (+ (cadr PtIns) HtTot) DiamExt Ep)
   Y1 (+ (cadr PtIns) HtBD)
 )

 (setvar "OSMODE" 0)
 (command "_.PLINE"
   (list X1 (nth 1 PtIns))
   (list X1 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)) 2)
   "_L"				; Ligne...
   (list (nth 0 PtIns) (+ Y0 DiamExt))
   "_A"
   "_CE"			; Arc défini par son centre
   (list (nth 0 PtIns) Y0)
   "_A"				; Angle...
   (* -1 (/ (- 180 (* 2 Ang1)) 2))
   "_CE"			; Arc défini par son centre
   (list (- X1 RayCar Ep) Y1)
   "_A"				; Angle..
   (* -1 Ang1)
   "_L"				; Ligne...
   (list (- X1 ep) (nth 1 PtIns))
   "_C"				; Ferme la polyligne 
 )
 (setq contourGRC (entlast))
 (command "_revolve"
   contourGRC
   ""
   PtIns
   (list (nth 0 PtIns) Y0)
   "360"
 )

 (command "_ucs" "_r" "tempftd")
 (setvar "OSMODE" osm)
 (setvar "ELEVATION" elev)
 (command "_undo" "_e")
 (setvar "CMDECHO" echo)
 (princ)
)

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

[Edité le 11/6/2009 par usegomme]

didier · le 10 juin 2009

bonjour

je suis toujours aussi curieux de voir comment travaillent les autres

aussi j'ai regardé ton message

j'ai regardé aussi l'image attachée sur le message initial

ma question est :

quel est le résultat de ce lisp ?

parce que je n'arrive pas à dessiner quoi que ce soit d'intelligible.

amicalement

usegomme · le 10 juin 2009

Salut Didier, tu m'as fait peur , j'ai cru que j'avais foiré mon copier/coller du code.

Un fond GRC est , par exemple le dôme arrondi d'une cuve verticale .

GRC c'est fond en anse de panier à Grand Rayon de Carre.

Essai diametre 200 , epaisseur 2 et hauteur 20

puis le point d'insertion avec une orientation ou pas.

Et tu devrais obtenir un solide 3 D représentant le fond GRC en question.

didier · le 11 juin 2009

coucou

quand je dis inintelligible, il n'y a qu'à voir l'image

elle est le résultat des valeurs citées.

http://images.imagehotel.net/jkwkrxy5rl_tn.jpg

amicalement

lili2006 · le 11 juin 2009

Bonjour à toutes et tous,

Pas mal ta baleine didier,... ;)

didier · le 11 juin 2009

coucou

cétacé LILI2006 :)

je me cache à l'eau ...

j'espère continuer ce message ailleurs, (suivez moi)

il est passionnant ce problème de fond elliptiques

si (gile) le voit, il va nous faire un miracle.

amicalement

(gile) · le 11 juin 2009

Salut,

Ça fonctionne bien chez moi :

http://img19.imageshack.us/img19/1875/fgrc.png

Il est possible que le problème vienne du fait que didier travaille en grades et pas en degrés.

Raph_38 · le 11 juin 2009

Ce serait le TOP si les valeurs des fond étaient déjà enregistrées dans le lisp et que l'on ai que le DN à entrer ;)

bonuscad · le 11 juin 2009

Fonctionne aussi chez moi.

Cependant des imperfections au niveaux des entrées utilisateur.

Sur la rotation par exemple, si je rentre 0 en valeur, il me dit qu'il attend un point??, c'est pas un angle...?

D'ailleurs cela m'a fait avorter la routine. (en cliquant un point, ça va bien)

Les dimensions ne peuvent être rentrées qu'au clavier, pas de manière graphique.

usegomme · le 11 juin 2009

Ouah ! Je suis arrivé à faire un lisp qui fait des baleines , je deviens vraiment trés fort.

En fait c'est parce que je suis allé au Marineland d'Antibes dimanche.

Plus sérieusement il y a problème avec une valeur d' élévation différente de zéro, il faut que je corrige. Mais je n'ai pas réussi à faire une baleine .

Il est possible que le problème vienne du fait que didier travaille en grades et pas en degrés

C'est sûr que ça ne peut pas fonctionner avec les grades.

Sur la rotation par exemple, si je rentre 0 en valeur, il me dit qu'il attend un point??, c'est pas un angle...?

C'est pour pouvoir s' orienter aussi en "z" , à voir pour faire mieux.

Les dimensions ne peuvent être rentrées qu'au clavier, pas de manière graphique

C'est parce j'ai repris tel quel FondB.lsp , mais je note.

Ce serait le TOP si les valeurs des fond étaient déjà enregistrées dans le lisp et que l'on ai que le DN à entrer

Je pourrais le faire partiellement (il y a trop de dimensions) quand j'aurai le temps, mais sa complique aussi le lisp.

il est passionnant ce problème de fond elliptiques
si (gile) le voit, il va nous faire un miracle.

D'abord ce n'est pas un fond elliptique , et un fond GRC changé en baleine c'est déjà pas mal comme miracle.

lili2006 · le 11 juin 2009

Re,

et un fond GRC changé en baleine c'est déjà pas mal comme miracle.

J'crois qu'c'est clair,..... :P

nicolas2 · le 11 juin 2009

Bonjour à tous,

Chouette Baleine....!!

J'ai déja eu le problème du cétacé et pour le contourner, je ne choisis pas de point d'insertion précis, je jette le fond à côté du plan et je le déplace ensuite.Essais ça Didier et dit nous.

Pour ta demande Neptune38, voici un extrait du nombre de fonds standards que l'on peut rencontrer (extrait CEREC fabriquant de fonds) en sachant qu'il propose ceci du Ø150 au Ø5400.

http://img197.imageshack.us/img197/4593/fondgrc.jpg

Les LISP existant, avant celui-ci, étaient limitatifs dans leur utilisation.

Celui-ci a le mérite d'ouvrir justement à une utilisation non-restrictive.

Je crois savoir que tu es chaudronnier dans le 38 (comme moi :casstet: ) depuis de nombreuses années et pour ma part, il est très rare que je tombe sur des fonds standards.

Mes dernières Affaires

- Ø1212

- Ø4837

- Ø807......

J'hésite à me démasquer..............le Yann NICOLLET du programme...............c'est moi........ :cool:

Voici le même pour les Fonds elliptiques (en 2D aidé par plusieurs CADxpiens)

 (defun c:FE ( / DiamExt Ep HtBD PtIns dxf_210)
(setq os (getvar "osmode"))		; stocker
(setvar "osmode" 0)			; désactiver
(initget 7)
(setq DiamExt (getdist "\nDiamètre extérieur: "))
(initget 7)
(setq Ep (getdist "\nEpaisseur: "))
(initget 7)
(setq HtBD (getdist "\nHauteur du bord droit: "))
(initget 9)
(setq
PtIns (getpoint "\nPoint d'insertion: ")
dxf_210 (mapcar 'caddr (mapcar '(lambda (x) (trans x 0 1 T)) '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))))
)
(entmake
(list
(cons 0 "ELLIPSE")
(cons 100 "AcDbEntity")
(if (/= (getvar "CVPORT") 2)
(cons 67 1)
(cons 67 0)
)
(cons 410 (getvar "CTAB"))
(cons 8 (getvar "CLAYER"))
(cons 100 "AcDbEllipse")
(cons 10 (trans (list (car Ptins) (+ (cadr PtIns) HtBD) (caddr PtIns)) 1 0))
(cons 11 (trans (list (* DiamExt 0.5) 0.0 0.0) 1 0 T))
(cons 210 dxf_210)
(cons 40 (/ (+ (/ (- DiamExt (* 2.0 Ep)) 3.8) Ep) (* DiamExt 0.5)))
(cons 41 0.0)
(cons 42 pi)
)
)
(entmake
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(if (/= (getvar "CVPORT") 2)
(cons 67 1)
(cons 67 0)
)
(cons 410 (getvar "CTAB"))
(cons 8 (getvar "CLAYER"))
(cons 100 "AcDbPolyline")
(cons 90 4)
(cons 70 0)
(cons 43 0.0)
(cons 38 (caddr (trans PtIns 1 dxf_210)))
(cons 39 0.0)
(cons 10 (trans (list (- (car Ptins) (* DiamExt 0.5)) (+ (cadr PtIns) HtBD) (caddr PtIns)) 1 dxf_210))
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 10 (trans (list (- (car Ptins) (* DiamExt 0.5)) (cadr PtIns) (caddr PtIns)) 1 dxf_210))
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 10 (trans (list (+ (car Ptins) (* DiamExt 0.5)) (cadr PtIns) (caddr PtIns)) 1 dxf_210))
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 10 (trans (list (+ (car Ptins) (* DiamExt 0.5)) (+ (cadr PtIns) HtBD) (caddr PtIns)) 1 dxf_210))
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 210 dxf_210)
)
)
(setvar "osmode" os)		; restaurer
(prin1)
)

Pour ma part, j'aurais bien vu une Box avec le choix du:

- Type de fond (coche plutôt que déroulant)

- 2D, 3D (coche plutôt que déroulant)

- Ø

- épaisseur

- hauteur du bord droit

Voila, voila.......si une âme charitable veut s'y atteler.....

Merci à tous

usegomme · le 11 juin 2009

Merci Nicolas2 pour ton travail , tu vois que ça profite .

J'ai fait une petite mise à jour du code , version 1.1

Mais pour les grades à Didier , je ne pense pas que de jetter le fond ça puisse l'aider . Et je ne sais pas comment faire.

(gile) · le 11 juin 2009

Salut,

Mais pour les grades à Didier , je ne pense pas que de jetter le fond ça puisse l'aider . Et je ne sais pas comment faire.

Tu utilises command et c'est le seul cas en LISP où les angles doivent être spécifiés dans l'unité angulaire courante tout le reste se fait en radians.

Comme command accepte les arguments numéraires aussi bien sons forme de nombres que de chaînes, tu peux utiliser angtos qui convertit un nombre en chaîne mais aussi des radians vers l'unité courante ou spécifiée.

Quand tu récupères l'angle avec la fonction angle le résultat est en radians, tu le conserves dans une variable :

(setq AngRad (angle (list (nth 0 PtIns) Y0)
	    (list (- X1 RayCar Ep) Y1)
     )
)

Si tu dois le passer tel quel tu peux faire :

(angtos AngRad (getvar "AUNITS") 16)

avec 16 décimales pour avoir la précision maximale.

Si tu as des calculs à faire, tu les fais en radians et tu convertis le résultat de la même façon pour l'utiliser avec command

exemple pour ajouter 90° à AngRad et le convertir :

(angtos (+ AngRad (/ pi 2)) (getvar "AUNITS") 16)

usegomme · le 11 juin 2009

Mais c'est un puit de sciences ce (gile) !

Je ne sais pas si c'est l'heure tardive mais ça rentre péniblement dans ma pit' tête.

Et restera à mettre en pratique.

Merci.

usegomme · le 12 juin 2009

Bonjour , j'ai appliqué ce que tu m'as indiqué (Gile) , le seul angle que je n'arrive pas à retourner c'est 360 car angtos me donne 0, heureusement que la révolution est de 360 par défaut. En tout cas merci , et reste à Didier de vérifier si les baleines ont repris le chemin du large.

 
;usegomme le 12-06-2009
;Version 2.03 15-06-09
;Fait à partir de FondB.lsp écrit par Maxence Delannoy et modifié par Yann Nicollet avec l'aide de Bonuscad et Bred
;Objet: Tracé de fonds GRC en 3D suivant NF E 81-102.

(defun c:Fgrc (/  DiamExt RayInt RayCar Ep HtBD	HtTot
       PtIns  X0     X1	    Y0	   Y1	  Ang1	 fgrc:pdir	osm
       echo   elev fgrc:rot
      )
 (if (not fgrc:diamext)
   (setq fgrc:diamext 200
  fgrc:ep 2
  fgrc:htbd 20
   )
 )
 (command "_undo" "_be")
 (setq
   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)
 )
 (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)
 )
 (setq
   HtBD (getdist
   (strcat "\nHauteur du bord droit cylindrique ou 2 pts <"
	   (rtos fgrc:HtBD 2 4)
	   ">: "
   )
 )
 )
 (if HtBD
   (setq fgrc:HtBD HtBD)
   (setq HtBD fgrc:HtBD)
 )
 (setq
   RayCar (/ DiamExt 10.0)
   HtTot  (+ HtBD
      Ep
      (- DiamExt
	 (sqrt (- (expt (- DiamExt RayCar) 2.0)
		  (expt (- (* DiamExt 0.5) Ep RayCar) 2.0)
	       )
	 )
      )
   )

   PtIns  (getpoint "\nPoint d'insertion <0,0>: ")
 )
 (if (not PtIns) (setq PtIns '(0. 0.)))
 (setvar "cmdecho" 0)
				; sauve scu courant
 (command "_ucs" "_s" "tempftd")
 (if (not (zerop (getvar "cmdactive")))
   (command "_y")
 )
 (setq fgrc:pdir (getpoint PtIns "\n orientation du fond GRC : "))
 (cond
   (fgrc:pdir
    (setvar "ELEVATION" 0)
    (command "_ucs" "_zaxis" "_none" PtIns "_none" fgrc: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 fgrc:rot (getangle  "\n angle de rotation du fond GRC  <0 , suivant axe X>: "))
    (if fgrc:rot (setq fgrc:rot (- fgrc:rot (* 0.5 pi)))(setq fgrc:rot (* 1.5 pi) ))
   )
 )

 (setq
   X0 (- (car PtIns) (* DiamExt 0.5))
   X1 (+ (car PtIns) (* DiamExt 0.5))
   Y0 (- (+ (cadr PtIns) HtTot) DiamExt Ep)
   Y1 (+ (cadr PtIns) HtBD)
 )

 (setvar "OSMODE" 0)
 (command
   "_.PLINE"
   (list X1 (nth 1 PtIns))
   (list X1 Y1)
   "_A"
   "_CE"				; Arc défini par son centre
   (list (- X1 RayCar Ep) Y1)
   "_A"				; Angle...
   (angtos
     (setq angRad (angle (list (nth 0 PtIns) Y0)
		  (list (- X1 RayCar Ep) Y1)
	   )
     )
     (getvar "AUNITS")
     16
   )
   "_CE"
   (list (nth 0 PtIns) Y0)
   "_A"				; Angle...
   (angtos (/ (- pi (* 2 angRad)) 2) (getvar "AUNITS") 16)
   "_L"				; Ligne...
   (list (nth 0 PtIns) (+ Y0 DiamExt))
   "_A"
   "_CE"				; Arc défini par son centre
   (list (nth 0 PtIns) Y0)
   "_A"				; Angle...
   (strcat "-"
    (angtos (/ (- pi (* 2 angRad)) 2) (getvar "AUNITS") 16)
   )
   "_CE"				; Arc défini par son centre
   (list (- X1 RayCar Ep) Y1)
   "_A"				; Angle..
   (strcat "-" (angtos angRad (getvar "AUNITS") 16))
   "_L"				; Ligne...
   (list (- X1 ep) (nth 1 PtIns))
   "_C"				; Ferme la polyligne 
 )

 (command "_revolve"
   "_l"
   ""
   PtIns
   (list (nth 0 PtIns) Y0)
   ""
 )
 (if fgrc:rot (command "_rotate" "_l" "" PtIns (angtos fgrc:rot (getvar "AUNITS") 16)))
 (if fgrc:pdir (command "_ucs" "_r" "tempftd"))
 (setvar "OSMODE" osm)
 (setvar "ELEVATION" elev)
 (command "_undo" "_e")
 (setvar "CMDECHO" echo)
 (princ)
)

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

[Edité le 12/6/2009 par usegomme][Edité le 12/6/2009 par usegomme][Edité le 12/6/2009 par usegomme][Edité le 15/6/2009 par usegomme][Edité le 15/6/2009 par usegomme]

[Edité le 15/6/2009 par usegomme]

usegomme · le 12 juin 2009

La version 2 est arrivée avec quelques améliorations (voir au-dessus).

a+

didier · le 13 juin 2009

bonsoir

effectivement maintenant ça fonctionne

je propose d'insérer ces lignes

(setvar "aunits" 0)

(setvar "angbase" 0)

(setvar "angdir" 0)

pour compatibilité avec la terre entière

chaque machine ayant son paramétrage

il faut la mettre dans le système attendu.

amicalement

[Edité le 13/6/2009 par didier]

(gile) · le 13 juin 2009

Salut,

J'ai aussi réussi à faire une "baleine" en paramétrant AutoCAD à la façon géomètre : AUNITS = 2 (grades), ANGDIR = 1 (horaire) et ANGBASE = 100g ou 90 (0 au Nord).

C'est au moment de la construction de la polyligne que ça cafouille et que ça dessine un profil "non extrudable"

Le problème avec la fonction command, c'est qu'il faut intégrer tous ces paramètres quand on a besoin d'utiliser des angles (ajouter ou supprimer la valeur de ANGBASE en fonction de la valeur de ANGDIR)

C'est pourquoi je trouve parfois plus simple en 3d d'utiliser entmake ou vla-add*, de travailler en radians, et d'utiliser la direction d'extrusion ou normale des entités 2d.

bonuscad · le 13 juin 2009

Bonjour,

Quand j'utilise (command) et qu'un angle est requis, pour être sur que celui ci soit compris quelque soit le système utilisé, j'utilise introduction par deux points :points d'origine de rotation et point fixant l'angle.

Ce dernier est calculé avec la fonction (polar) avec un angle en radian, (la distance n'important peu), ainsi autocad traduit automatiquement l'angle dans le système utilisé.

Pour les commandes acceptant introduction de l'angle par 2 points, ça fonctionne bien.

On peut aussi dessiner avec (command) et l'orientation 0.0 par défaut, puis avec un (entmod (subst (entlast))) changer l'angle en radian de la dernière entité mise en place.

usegomme · le 15 juin 2009

Salut , voici la version 3, j'ai essayé de régler les problèmes précèdents et maintenant la hauteur du bord droit (la partie cylindrique ) est prédéfinie , mais pas fixée , en fonction de l'épaisseur de la tôle suivant la doc que je possède , à vous de me dire si les seuils sont convenables.

;usegomme Version 3 le 15-06-2009
;Fait à partir de FondB.lsp écrit par Maxence Delannoy et modifié par Yann Nicollet avec l'aide de Bonuscad et Bred
;Objet: Tracé de fonds GRC en 3D suivant NF E 81-102.

(defun c:Fgrc (/       DiamExt RayInt  RayCar  Ep      HtBD    HtTot
       PtIns   X0      X1      Y0      Y1      Ang1    fgrc:pdir
       osm     echo    elev    fgrc:rot abase adir
      )
 (if (not fgrc:diamext) (setq fgrc:diamext 200 fgrc:ep 2 ))
 (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
   ((< ep 3) (setq fgrc:htbd 20))
   ((< ep 5) (setq fgrc:htbd 25))
   ((< ep 8) (setq fgrc:htbd 40))
   ((< ep 11) (setq fgrc:htbd 50))
   ((< ep 14) (setq fgrc:htbd 55))
   ((< ep 16) (setq fgrc:htbd 60))
   ((< ep 18) (setq fgrc:htbd 65))
   ((< ep 22) (setq fgrc:htbd 70))
   ((< ep 25) (setq fgrc:htbd 75))
   ((< ep 28) (setq fgrc:htbd 80))
   ((< ep 32) (setq fgrc:htbd 90))
   ((< ep 35) (setq fgrc:htbd 100))
   ((< ep 40) (setq fgrc:htbd 110))
   ((< ep 45) (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
      Ep
      (- DiamExt
	 (sqrt (- (expt (- DiamExt RayCar) 2.0)
		  (expt (- (* DiamExt 0.5) 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	fgrc:pdir
 (getpoint PtIns "\n orientation du fond GRC : ")
 )
 (cond
   (fgrc:pdir
    (setvar "ELEVATION" 0)
    (command "_ucs" "_zaxis" "_none" PtIns "_none" fgrc: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 fgrc:rot
    (getangle
      "\n angle de rotation du fond GRC  <0 , suivant axe X>: "
    )
    )
    (if fgrc:rot
      (setq fgrc:rot (- fgrc:rot (* 0.5 pi)))
      (setq fgrc: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 Ep)
   Y1 (+ (cadr PtIns) HtBD)
 )

 (setvar "OSMODE" 0)
 (command
   "_.PLINE"
   (list X1 (nth 1 PtIns))
   (list X1 Y1)
   "_A"
   "_CE"				; Arc défini par son centre
   (list (- X1 RayCar Ep) Y1)
   "_A"				; Angle...
   (angtos
     (setq angRad (angle (list (nth 0 PtIns) Y0)
		  (list (- X1 RayCar Ep) Y1)
	   )
     )
     (getvar "AUNITS")
     16
   )
   "_CE"
   (list (nth 0 PtIns) Y0)
   "_A"				; Angle...
   (angtos (/ (- pi (* 2 angRad)) 2) (getvar "AUNITS") 16)
   "_L"				; Ligne...
   (list (nth 0 PtIns) (+ Y0 DiamExt))
   "_A"
   "_CE"				; Arc défini par son centre
   (list (nth 0 PtIns) Y0)
   "_A"				; Angle...
   (strcat "-"
    (angtos (/ (- pi (* 2 angRad)) 2) (getvar "AUNITS") 16)
   )
   "_CE"				; Arc défini par son centre
   (list (- X1 RayCar Ep) Y1)
   "_A"				; Angle..
   (strcat "-" (angtos angRad (getvar "AUNITS") 16))
   "_L"				; Ligne...
   (list (- X1 ep) (nth 1 PtIns))
   "_C"				; Ferme la polyligne 
 )

 (command "_revolve"
   "_l"
   ""
   PtIns
   (list (nth 0 PtIns) Y0)
   ""
 )
 (if fgrc:rot
   (command "_rotate"
     "_l"
     ""
     PtIns
     (angtos fgrc:rot (getvar "AUNITS") 16)
   )
 )
 (if fgrc: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 " FGRC.lsp chargé.")
(prompt
 "\nTapez FGRC pour dessiner un fond GRC en 3D suivant NF E 81-102."
)
(princ)

usegomme · le 16 juillet 2009

Et la version 4 , j'ai opté pour la méthode par soustraction de solide comme ici avec les fond elliptique et donc si on entre une épaisseur négative l'intérieur du fond n'est pas représenté en creux.

; FGRC.lsp Version 4
;usegomme  le 11-07-2009
;Fait à partir de FondB.lsp écrit par Maxence Delannoy et modifié par Yann Nicollet avec l'aide de Bonuscad et Bred
;Objet: Tracé de fonds GRC en 3D suivant NF E 81-102.

(defun c:Fgrc (/       DiamExt RayInt  RayCar  Ep      HtBD    HtTot
       PtIns   X0      X1      Y0      Y1      Ang1    fgrc:pdir
       osm     echo    elev    fgrc: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	fgrc:pdir
 (getpoint PtIns "\n orientation du fond GRC : ")
 )
 (cond
   (fgrc:pdir
    (setvar "ELEVATION" 0)
    (command "_ucs" "_zaxis" "_none" PtIns "_none" fgrc: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 fgrc:rot
    (getangle
      "\n angle de rotation du fond GRC  <0 , suivant axe X>: "
    )
    )
    (if fgrc:rot
      (setq fgrc:rot (- fgrc:rot (* 0.5 pi)))
      (setq fgrc: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...
    (angtos
     (setq angRad (angle (list (nth 0 PtIns) Y0)
		  (list (- X1 RayCar Ep) Y1)
	   )
     )
     (getvar "AUNITS")
     16
    )
    "_CE"
    (list (nth 0 PtIns) Y0)
    "_A"				; Angle...
    (angtos (/ (- pi (* 2 angRad)) 2) (getvar "AUNITS") 16)
    "_L"    ; Ligne...
    Ptins
    "_C"				; Ferme la polyligne 
   )
   (command "_revolve"
   "_l"
   ""
   PtIns
   (list (nth 0 PtIns) Y0)
   ""
  )
 
   (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...
   (angtos
     (setq angRad (angle (list (nth 0 PtIns) Y0)
		  (list (- X1 RayCar (abs ep)) Y1)
	   )
     )
     (getvar "AUNITS")
     16
   )
   "_CE"
   (list (nth 0 PtIns) Y0)
   "_A"				; Angle...
   (angtos (/ (- pi (* 2 angRad)) 2) (getvar "AUNITS") 16)
   "_L"    ; Ligne...
   Ptins
   "_C"				; Ferme la polyligne 
 )

 (command "_revolve"
   "_l"
   ""
   PtIns
   (list (nth 0 PtIns) Y0)
   ""
 )

 (if (> ep 0) (command "_subtract" "_l" "" elint ""))
 (if fgrc:rot
   (command "_rotate"
     "_l"
     ""
     PtIns
     (angtos fgrc:rot (getvar "AUNITS") 16)
   )
 )
 (if fgrc: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 " FGRC.lsp chargé.")
(prompt
 "\nTapez FGRC pour dessiner un fond GRC en 3D suivant NF E 81-102."
)
(princ)

Fond GRC 3d

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante