SI, Exemples Lisp pour Autocad (AutoLisp) Bibliothèque de fonctions

AutoLisp

Ce fichier mabib.lsp constitue la bibliothèque des fonctions utilisée par la suite.
Attention au format des fichiers de dimensions : les valeurs sont positionnées par colonne, le moindre décalage sera fatal !
Par exemple 2.1 et 4 sont alignés à gauche sur la même colonne.
(La visualisation sur une page web ne permet pas de le voir correctement)
Voici, par exemple, un extrait de SKF_1RB.dim :

....
300 380 38 326 356 2.1 172000 245000 61860 1.7 5600 10.5
300 420 56 338 382 3 270000 375000 61960 1.6 8300 24.5
300 460 50 352 408 4 286000 405000 16060 1.5 8800 32.0
300 460 74 350 410 4 358000 500000 6060 1.5 10800 44.0
320 400 38 346 375 2.1 172000 255000 61864 1.6 5700 11.0
320 440 56 358 402 3 276000 400000 61964 1.5 8650 25.5
320 480 50 372 428 4 281000 405000 16064 1.4 8650 34.0
320 480 74 370 431 4 371000 540000 6064 1.4 11400 46.0
340 420 38 366 395 2.1 178000 275000 61868 1.5 6000 11.5
340 460 56 378 422 3 281000 425000 61968 1.4 9000 26.5
340 520 57 398 462 4 345000 520000 16068 1.3 10600 45.0
340 520 82 396 462 5 423000 640000 6068 1.3 13200 62.0
...

Ces fichiers dimensionnels demandent un temps considérable pour être constitués.
Ils ne sont pas fournis ici.

;-------------------------------------------------------------------------------
;                 Fichier de Base 
;           tracé des roulements SKF
;	parois moulées
; 	vérification données entrées
;                 (C) 1995 ... Jean-Paul MOLINA
;-------------------------------------------------------------------------------
;                nouveau gestionnaire d'erreur
;------------------------------------------------------------------------------
(defun new_hdle_error(s)           ; Si CTRL-C apparaît
    (if (/= s "Fonction annulée.")
      (princ (strcat "\nErreur : " s))
    )
    (if olderr (setq *error* olderr))   ; Restaure ancien *error* handler
    (princ)
)
;---------------------------------------------------------------------------- 
; Reset  error tile : null.
;---------------------------------------------------------------------------- 
(defun raz_error()
    (set_tile "error" "")
)
;-------------------------------------------------------------------------------
;                      Conversion radian --> degr
;-------------------------------------------------------------------------------
(defun radeg(a)
     (* 180 ( / a pi))
)
;-------------------------------------------------------------------------------
;                      Conversion degr -->  radian
;-------------------------------------------------------------------------------
(defun DegRad(alpha)
      (/ (* pi alpha) 180.0)
)
;-------------------------------------------------------------------------------
;                         Tangente 
;-------------------------------------------------------------------------------
(defun Tan(alpha)
      (/ (sin (DegRad alpha)) (cos (DegRad alpha)) )
)
;-------------------------------------------------------------------------------   
;         Cette fonction confirme si le nombre entré est correct 
;-------------------------------------------------------------------------------   
;;;  filtres:
;;;                 0 - tout nombre OK
;;;                 1 - rejette nbre positif
;;;                 2 - rejette nbre nul
;;;                 4 - rejette nbre negatif
;;;   
;-------------------------------------------------------------------------------
(defun check_real(value filtre coord / nbreOK msg)
   (raz_error)
   (setq msg  (strcat "Donnée " (strcase (substr coord 1 1)) " Incorrecte."))
   (cond
    ;; nombre ??
    ( (not (setq nbreOK (distof value)))
      (set_tile "error" msg)
      nil
    )
    ;; positif ??
    ( (and (= 1 (logand 1 filtre))
       (= (abs nbreOK) nbreOK)
    )
      (set_tile "error" msg)
      nil
    )
    ;; nul ??
    ( (and (= 2 (logand 2 filtre))
       (= 0.0 nbreOK)
     )
      (set_tile "error" msg)
      nil
    )
    ;; negatif ??
    ((and (= 4 (logand 4 filtre))
       (/= (abs nbreOK) nbreOK)
     )
      (set_tile "error" msg)
      nil
    )
    (T nbreOK)
  )
)
;-------------------------------------------------------------------------------
;                 vérifie l'angle et retourne la valeur 
;                 ou nil et un message d'erreur
;-------------------------------------------------------------------------------
(defun check_angle(value coord / nbreOK msg)
  (raz_error)
  (setq msg  (strcat "Donnée " (strcase (substr coord 1 1)) " Incorrecte."))
  (cond
    ((and (setq nbreOK (angtof value))
     )
      (set_tile "error" "")
      (atof (angtos nbreOK))
    )
    (T (set_tile "error" msg) nil)
  )
)
;-------------------------------------------------------------------------------   
;  Cette fonction confirme si toutes les entrées sont correctes
;-------------------------------------------------------------------------------   
(defun check_data()
    (cond
      ( (not (setq x_pt 
		  (check_real (get_tile "x_pt") 0 "x_pt")) )
		  (mode_tile "x_pt" 2) 
      ) 
      ( (not (setq y_pt 
		  (check_real (get_tile "y_pt") 0 "y_pt")) )
		  (mode_tile "y_pt" 2) 
      ) 
      ( (not (setq dnom
		  (check_real (get_tile "dnom") 4 "dnom")) )
		  (mode_tile "dnom" 2) 
      ) 
      ( (not (setq ep 
		  (check_real (get_tile "e_trait") 4 "e_trait")) )
		  (mode_tile "e_trait" 2) 
      ) 
      ( (not (setq inclin 
		  (check_angle (get_tile "rot")  "rot")) )
		  (mode_tile "rot" 2)
      ) 
     (T (done_dialog ) )
    )
)  
;-------------------------------------------------------------------------------   
;  Cette fonction confirme si toutes les entrées sont correctes
;     saisie du point , de l'angle et de l'épaisseur
;-------------------------------------------------------------------------------   
(defun check_saisie()
    (cond
      ( (not (setq x_pt 
		  (check_real (get_tile "x_pt") 0 "x_pt")) )
		  (mode_tile "x_pt" 2) 
      ) 
      ( (not (setq y_pt 
		  (check_real (get_tile "y_pt") 0 "y_pt")) )
		  (mode_tile "y_pt" 2) 
      ) 
      ( (not (setq ep 
		  (check_real (get_tile "e_trait") 4 "e_trait")) )
		  (mode_tile "e_trait" 2) 
      ) 
      ( (not (setq inclin 
		  (check_angle (get_tile "rot")  "rot")) )
		  (mode_tile "rot" 2)
      ) 
     (T (done_dialog ) )
    )
)  
;-------------------------------------------------------------------------------   
;  Cette fonction confirme si toutes les entrées sont correctes
;-------------------------------------------------------------------------------   
(defun check_data_paroi( )
    (cond
      ( (not (setq x_pt 
		  (check_real (get_tile "x_pt") 0 "x_pt")) )
		  (mode_tile "x_pt" 2) 
      ) 
      ( (not (setq y_pt 
		  (check_real (get_tile "y_pt") 0 "y_pt")) )
		  (mode_tile "y_pt" 2) 
      ) 
      ( (not (setq ep 
		  (check_real (get_tile "e_trait") 4 "e_trait")) )
		  (mode_tile "e_trait" 2) 
      ) 
      ( (not (setq inclin 
		  (check_angle (get_tile "rot")  "rot")) )
		  (mode_tile "rot" 2)
      ) 
      (  (and (not option)
	      (not (setq angdie 
		  (check_diedre (get_tile "die")  "die")) )
		  (mode_tile "die" 2) 
	 )
      ) 
      ( (and (not option) 
	  (not (and (> angdie 0) (<  angdie 90) ) ) 
	       (mode_tile "die" 2)
		(set_tile "error" ">>>>    0ø < Angle diêdre < 90ø")
	)  
      )
      ( (not (setq Es
		  (check_real (get_tile "epaiss") 4 "epaiss")) )
		  (mode_tile "epaiss" 2) 
      ) 
      ( (not (setq Ei
		  (check_real (get_tile "mince") 4 "mince")) )
		  (mode_tile "mince" 2) 
      ) 
      ( (not (<= Ei Es)) 
		  (mode_tile "mince" 2) 
		  (set_tile "error" ">>>> Epaisseur incorrecte") 
      )
      (T (done_dialog ) )
    )
) 
;-------------------------------------------------------------------------------   
;   action dnom
;-------------------------------------------------------------------------------   
(defun do_dnom()
    (check_real (setq dnom $value) 4 "dnom")  
    (check_real (setq dnom $value) 2 "dnom") 
)
;-------------------------------------------------------------------------------   
;   action angle
;-------------------------------------------------------------------------------   
(defun do_angle()
    (check_angle (setq inclin $value) "rot")  
)
;-------------------------------------------------------------------------------   
;   action trait       ( 4 == >rejette nbre < 0 )
;-------------------------------------------------------------------------------   
(defun do_ep()
    (check_real (setq ep $value ) 4 "e_trait")  
)
;-------------------------------------------------------------------------------   
;  X coordinate action.
;-------------------------------------------------------------------------------   
(defun do_x_pt()
    (check_real (setq x_pt $value) 0 "x_pt") 
)
;-------------------------------------------------------------------------------   
;  Y coordinate action.
;-------------------------------------------------------------------------------   
(defun do_y_pt()
    (check_real (setq y_pt $value) 0 "y_pt")  
)
;-------------------------------------------------------------------------------
(defun defaults()
    ;désactive les éléments ref
    (mode_tile "ref" 1) 
    (mode_tile "z_pt" 1)   ;désactive z_pt
    (if x_pt 
       (set_tile "x_pt" x_pt) 
       (progn
	     (set_tile "x_pt" (rtos 0.00 2))
	     (setq x_pt (rtos 0.00 2))
       )
    )
    (if y_pt 
       (set_tile "y_pt" y_pt) 
       (progn
	     (set_tile "y_pt" (rtos 0.00 2))
	     (setq y_pt (rtos 0.00 2))
       )
    )
    (set_tile "rot" inclin)
    (set_tile "e_trait" ep)
    (set_tile "error" ">>>> Saisir le point avant le diamêtre")
)
;-------------------------------------------------------------------------------
;              	Roulements
;-------------------------------------------------------------------------------
;            Lit le fichier dimensionnel
;            Si diamêtre trouvé alors crée :
;                - un fichier temporaire
;                - une liste  afficher dans la boite de liste
;-------------------------------------------------------------------------------
 (defun Lire1RB( / ff fich F tampon break lref)
   (if (or (= art nil) (= art 0) ) (exit) )
   (setq ff (findfile "SKF_1RB.DIM") )
 	; rigide 1 rg de billes
   (if (= nil ff )
	  (progn
	    (alert "Fichier SKF_1RB.DIM non trouvé !")
	    (princ)
	  )
	  (progn
		 (setq fich (open ff "r") )
		 (setq lref (read-line fich) )
		 (setq OK 1)  ;...initialisations
		 (setq break 0)
		 (while (and (/= lref nil) (= 0 break) )  ;...cherche la bonne valeur
			(if (>= (atof (substr lref 1 3)) art)
				 (setq break 1)
				 (setq lref (read-line fich))
			 )
		 )
		 (if (OR (= lref nil)(> (atof (substr lref 1 3)) art)  )
		   (progn                   ;...ne la trouve pas
			   (alert "Ce diametre n'est pas reference!")
			   (close fich)
			   (setq OK 0)
			   nil
		   )
		   (progn
			    (setq list_ref nil)
			    (setq F (open "1RB.WRK" "w") )
			    (while (= (atof (substr lref 1 3)) art)
				 (progn
				    (print lref F) ; écriture dans fichier temporaire
				    (setq tampon
				     (strcat (substr lref 1 15) (substr lref 51 7))
				    )
					 ; création de la liste
				    (setq list_ref (cons tampon list_ref) )
				    (setq lref (read-line fich) )
				  )
			    )
			    (close F)
			    (close fich)
		   )
		 ) ;fin du if
	  );fin du progn
   );fin du if
)
;-------------------------------------------------------------------------------
;	2 rg de billes
;------------------------------------------------------------------------------
(defun Lire2RB( / ff fich F tampon break lref)
  (if (or (= art nil) (= art 0) ) (exit) )
  (setq ff (findfile "SKF_2RB.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier SKF_2RB.DIM non trouvé !")
	   (princ)
	 )
	 (progn
		(setq fich (open ff "r") )    
		(setq  lref (read-line fich) ) 
		(setq OK 1)  ;...initialisations
		(setq break 0)                    ;...cherche la bonne valeur
		(while (and (/= lref nil) (= 0 break) )
		    (if (>= (atof (substr lref 1 3)) art)
		       (setq break 1)
		       (setq lref (read-line fich))
		    )
		)
	  (if (OR (= lref nil) (> (atof (substr lref 1 3)) art) )
		  (progn                          ;...ne la trouve pas
			  (alert "Ce diametre n'est pas reference!")
			  (close fich)
			  (setq OK 0)
			  nil
		  )
		  (progn
			   (setq list_ref nil)
			   (setq F (open "2RB.WRK" "w") )
			   (while (= (atof (substr lref 1 3)) art)
				(progn
				   (print lref F) ; écriture dans fichier temporaire
				   (setq tampon
				    (strcat (substr lref 1 10) " " (substr lref 42 4))
				   )
					; création de la liste
				   (setq list_ref (cons tampon list_ref) )
				   (setq lref (read-line fich) )
				 )
			   )
			   (close F)
			   (close fich)
		  )
		) ;fin du if
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
;	rotule à billes
;-------------------------------------------------------------------------------
(defun LireROT( / ff fich F tampon break lref)
  (if (or (= art nil) (= art 0) ) (exit) )
  (setq ff (findfile "SKF_ROTB.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier SKF_ROTB.DIM non trouvé !")
	   (princ)
	 )
	 (progn
		(setq fich (open ff "r") )
		(setq lref (read-line fich) )
		(setq OK 1)  ;...initialisations
		(setq break 0)                    ;...cherche la bonne valeur
		(while (and (/= lref nil) (= 0 break) )
		    (if (>= (atof (substr lref 1 3)) art)
		       (setq break 1)
		       (setq lref (read-line fich))
		    )
		)
		
	  (if (OR (= lref nil)(> (atof (substr lref 1 3)) art)  )
		  (progn
			 (alert "Ce diametre n'est pas reference!")
			 (close fich)
			 (setq OK 0)
			 nil
	    )
	    (progn
		     (setq list_ref nil)
		     (setq F (open "ROT.WRK" "w") )
		     (while (= (atof (substr lref 1 3)) art)
			  (progn
			       (print lref F) ; écriture dans fichier temporaire
			       (setq tampon
				       (strcat (substr lref 1 10) " " (substr lref 41 5))
			       )
				  ; création de la liste
			       (setq list_ref (cons tampon list_ref) )
			       (setq lref (read-line fich) )
			  )
	       )
	       (close F)
	       (close fich)
	    )
	) ;fin du if
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
;	rotule 2 rg de tonneaux
;-------------------------------------------------------------------------------
(defun LireROT2T( / ff fich F tampon break lref)
  (if (or (= art nil) (= art 0) ) (exit) )
  (setq ff (findfile "SKF_R2T.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier SKF_R2T.DIM non trouvé !")
	   (princ)
	 )
	 (progn
		(setq fich (open ff "r") )
		(setq lref (read-line fich) )
		(setq OK 1)  ;...initialisations
		(setq break 0)                    ;...cherche la bonne valeur
		(while (and (/= lref nil) (= 0 break) )
		    (if (>= (atof (substr lref 1 3)) art)
		       (setq break 1)
		       (setq lref (read-line fich))
		    )
		)
		(if (OR (= lref nil)(> (atof (substr lref 1 3)) art)  )
		  (progn
		     (alert "Ce diametre n'est pas reference!")
		     (close fich)
		     (setq OK 0)
		    nil
	    )
	    (progn
		     (setq list_ref nil)
		     (setq F (open "R2T.WRK" "w") )
		     (while (= (atof (substr lref 1 3)) art)
			  (progn
			       (print lref F) ; écriture dans fichier temporaire
			       (setq tampon
				       (strcat (substr lref 1 11) " " (substr lref 46 13))
			       )
				  ; création de la liste
			       (setq list_ref (cons tampon list_ref) )
			       (setq lref (read-line fich) )
			  )
		     )
		     (close F)
		     (close fich)
		  )
		) ;fin du if
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
;	oblique
;-------------------------------------------------------------------------------
(defun LireOBL( / ff fich F tampon break lref)
  (if (or (= art nil) (= art 0) ) (exit) )
  (setq ff (findfile "SKF_OBL.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier SKF_OBL.DIM non trouvé !")
	   (princ)
	 )
	 (progn
		(setq fich (open ff "r") )
		(setq lref (read-line fich) )
		(setq OK 1)  ;...initialisations
	     (setq break 0)                    ;...cherche la bonne valeur
	     (while (and (/= lref nil) (= 0 break) )
		    (if (>= (atof (substr lref 1 3)) art)
		       (setq break 1)
		       (setq lref (read-line fich))
		    )
	     )
		(if (OR (= lref nil)(> (atof (substr lref 1 3)) art)  )
		  (progn
		     (alert "Ce diametre n'est pas reference!")
		     (close fich)
		     (setq OK 0)
		     nil
	    )
	    (progn
		     (setq list_ref nil)
		     (setq F (open "OBL.WRK" "w") )
		     (while (= (atof (substr lref 1 3)) art)
			  (progn
			       (print lref F) ; écriture dans fichier temporaire
			       (setq tampon
				       (strcat (substr lref 1 10) " " (substr lref 58 4))
			       )
				  ; création de la liste
			       (setq list_ref (cons tampon list_ref) )
			       (setq lref (read-line fich) )
			  )
		     )
		     (close F)
		     (close fich)
		  )
		) ;fin du if
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
;	rouleaux coniques
;-------------------------------------------------------------------------------
(defun LireCNQ( / ff fich F tampon break lref)
  (if (or (= art nil) (= art 0) ) (exit) )
  (setq ff (findfile "SKF_CNQ.DIM") )
  (if (= nil ff )
	(progn
	  (alert "Fichier SKF_CNQ.DIM non trouvé !")
	  (princ)
	)
	(progn
	  (setq fich (open ff "r") )
	  (setq lref (read-line fich) )
	  (setq OK 1)  ;...initialisations
	  (setq break 0)                    ;...cherche la bonne valeur
	  (while (and (/= lref nil) (= 0 break) )
	       (if (>= (atof (substr lref 1 3)) art)
			  (setq break 1)
			  (setq lref (read-line fich))
		     )
	     )
	  (if (OR (= lref nil)(> (atof (substr lref 1 3)) art)  )
	       (progn
			     (alert "Ce diametre n'est pas reference!")
			     (close fich)
			  (setq OK 0)
			  nil
		     )
		     (progn
		    (setq list_ref nil)
			     (setq F (open "CNQ.WRK" "w") )
			     (while (= (atof (substr lref 1 3)) art)
			 (progn
					  (print lref F) ; écriture dans fichier temporaire
					  (setq tampon
					       (strcat (substr lref 1 14) " "
					   (substr lref 79 11) " "
					   (substr lref 32 5)
				   )
					  )
					  ; création de la liste
					  (setq list_ref (cons tampon list_ref) )
					  (setq lref (read-line fich) )
				     )
			     )
			     (close F)
			     (close fich)
		     )
	       ) ;fin du if
	);fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
;	rouleaux cylindriques
;-------------------------------------------------------------------------------
(defun LireCYL( / ff fich F tampon break lref)
  (if (or (= art nil) (= art 0) ) (exit) )
  (setq ff (findfile "SKF_CYL.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier SKF_CYL.DIM non trouvé !")
	   (princ)
	 )
	 (progn
		(setq fich (open ff "r") )
		(setq lref (read-line fich) )
	     (setq OK 1)  ;...initialisations
	     (setq break 0)                    ;...cherche la bonne valeur
	     (while (and (/= lref nil) (= 0 break) )
		    (if (>= (atof (substr lref 1 3)) art)
		       (setq break 1)
		       (setq lref (read-line fich))
		    )
	     )
		(if (OR (= lref nil)(> (atof (substr lref 1 3)) art)  )
		  (progn
			  (alert "Ce diametre n'est pas reference!")
			  (close fich)
			  (setq OK 0)
			  nil
		  )
		     (progn
			  (setq list_ref nil)
			  (setq F (open "CYL.WRK" "w") )
			  (while (= (atof (substr lref 1 3)) art)
			       (progn
				    (print lref F) ; écriture dans fichier temporaire 
				    (setq tampon 
					    (strcat (substr lref 1 11) " " 
						  (substr lref 42 7))
				    )
				       ; création de la liste
				    (setq list_ref (cons tampon list_ref) )
				    (setq lref (read-line fich) )
			       )
			  )
			  (close F)
			    (close fich)
		     )
		) ;fin du if
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
;	butée à billes simple effet
;-------------------------------------------------------------------------------
(defun LireBUTSE( / ff fich F tampon break lref)
  (if (or (= art nil) (= art 0) ) (exit) )
  (setq ff (findfile "SKF_BTSE.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier SKF_BTSE.DIM non trouvé !")
	   (princ)
	 )
	 (progn
		(setq fich (open ff "r") )
		(setq lref (read-line fich) )
	     (setq OK 1)  ;...initialisations
	     (setq break 0)                    ;...cherche la bonne valeur
	     (while (and (/= lref nil) (= 0 break) )
		    (if (>= (atof (substr lref 1 3)) art)
		       (setq break 1)
		       (setq lref (read-line fich))
		    )
	     )     
		(if (OR (= lref nil)(> (atof (substr lref 1 3)) art)  )
		  (progn
			  (alert "Ce diametre n'est pas reference!")
			  (close fich)
		 (setq OK 0)
		       nil
		  )
		  (progn
			   (setq list_ref nil)
			   (setq F (open "BUT.WRK" "w") )
			   (while (= (atof (substr lref 1 3)) art)
				(progn
				   (print lref F) ; écriture dans fichier temporaire
				   (setq tampon
				    (strcat (substr lref 1 11) " " (substr lref 28 5))
				   )
					; création de la liste
				   (setq list_ref (cons tampon list_ref) )
				   (setq lref (read-line fich) )
				 )
			   )
			   (close F)
			   (close fich)
		  )
		) ;fin du if
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
;	butée à billes simple effet sphérique
;-------------------------------------------------------------------------------
(defun LireBUTSESP( / ff fich F tampon break lref)
   (if (or (= art nil) (= art 0) ) (exit) )
  (setq ff (findfile "SKF_BSSP.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier SKF_BSSP.DIM non trouvé !")
	   (princ)
	 )
	 (progn
		(setq fich (open ff "r") )
		(setq lref (read-line fich) )
	     (setq OK 1)  ;...initialisations
	     (setq break 0)                    ;...cherche la bonne valeur
	     (while (and (/= lref nil) (= 0 break) )
		    (if (>= (atof (substr lref 1 3)) art)
		       (setq break 1)
		       (setq lref (read-line fich))
		    )
	     )
		(if (OR (= lref nil)(> (atof (substr lref 1 3)) art)  )
		  (progn
			  (alert "Ce diametre n'est pas reference!")
			  (close fich)
		       (setq OK 0)
		 nil
		  )
		  (progn
			   (setq list_ref nil)
			   (setq F (open "BSSP.WRK" "w") )
			   (while (= (atof (substr lref 1 3)) art)
				(progn
				   (print lref F) ; écriture dans fichier temporaire
				   (setq tampon
				    (strcat (substr lref 1 12) " " (substr lref 29 5))
				   )
					; création de la liste
				   (setq list_ref (cons tampon list_ref) )
				   (setq lref (read-line fich) )
				 )
			   )
			   (close F)
			   (close fich)
		  )
		) ;fin du if
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
;	butée à billes double effet
;-------------------------------------------------------------------------------
(defun LireBUTDE( / ff fich F tampon break lref)
  (if (or (= art nil) (= art 0) ) (exit) )
  (setq ff (findfile "SKF_BTDE.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier SKF_BTDE.DIM non trouvé !")
	   (princ)
	 )
	 (progn
		(setq fich (open ff "r") )
		(setq lref (read-line fich) )
	     (setq OK 1)  ;...initialisations
	     (setq break 0)                    ;...cherche la bonne valeur
	     (while (and (/= lref nil) (= 0 break) )
		    (if (>= (atof (substr lref 1 3)) art)
		       (setq break 1)
		       (setq lref (read-line fich))
		    )
	     )
		(if (OR (= lref nil)(> (atof (substr lref 1 3)) art)  )
		  (progn
			  (alert "Ce diametre n'est pas reference!")
			  (close fich)
		       (setq OK 0)
		 nil
		  )
		  (progn
			   (setq list_ref nil)
			   (setq F (open "BUT.WRK" "w") )
			   (while (= (atof (substr lref 1 3)) art)
				(progn
				   (print lref F) ; écriture dans fichier temporaire
				   (setq tampon
				    (strcat (substr lref 1 11) " " (substr lref 28 5))
				   )
					; création de la liste
				   (setq list_ref (cons tampon list_ref) )
				   (setq lref (read-line fich) )
				 )
			   )
			   (close F)
			   (close fich)
		  )
	       ) ;fin du if
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
;	butée à billes double effet sphérique
;-------------------------------------------------------------------------------
(defun LireBUTDESP( / ff fich F tampon break lref)
  (if (or (= art nil) (= art 0) ) (exit) )
  (setq ff (findfile "SKF_BDSP.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier SKF_BDSP.DIM non trouvé !")
	   (princ)
	 )
	 (progn
		(setq fich (open ff "r") )
		(setq lref (read-line fich) )
		(setq OK 1)  ;...initialisations
	     (setq break 0)                    ;...cherche la bonne valeur
	     (while (and (/= lref nil) (= 0 break) )
		    (if (>= (atof (substr lref 1 2)) art)
		       (setq break 1)
		       (setq lref (read-line fich))
		    )
	     )
		(if (OR (= lref nil)(> (atof (substr lref 1 2)) art)  )
		  (progn
			  (alert "Ce diametre n'est pas reference!")
			  (close fich)
			   (setq OK 0)
			   nil
		  )
		  (progn
			   (setq list_ref nil)
			   (setq F (open "BDSP.WRK" "w") )
			   (while (= (atof (substr lref 1 2)) art)
				(progn
				   (print lref F) ; écriture dans fichier temporaire
				   (setq tampon
				    (strcat (substr lref 1 12) " " (substr lref 29 5))
				   )
					; création de la liste
				   (setq list_ref (cons tampon list_ref) )
				   (setq lref (read-line fich) )
				 )
			   )
			   (close F)
			   (close fich)
		  )
		) ;fin du if
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
;	rondelles étanchéïté SKF
;-------------------------------------------------------------------------------
(defun LireETA( / ff fich F tampon break lref)
  (if (or (= art nil) (= art 0) ) (exit) )
  (setq ff (findfile "SKF_ETA.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier SKF_ETA.DIM non trouvé !")
	   (princ)
	 )
	 (progn
		(setq fich (open ff "r") )
		(setq lref (read-line fich) )
	     (setq OK 1)  ;...initialisations
	     (setq break 0)                    ;...cherche la bonne valeur
	     (while (and (/= lref nil) (= 0 break) )
		    (if (>= (atof (substr lref 1 2)) art)
		       (setq break 1)
		       (setq lref (read-line fich))
		    )
	     )
		(if (OR (= lref nil)(> (atof (substr lref 1 2)) art)  )
		  (progn
			  (alert "Ce diametre n'est pas reference!")
			  (close fich)
			   (setq OK 0)
			   nil
		  )
		  (progn
			     (setq list_ref nil)
			  (setq F (open "ETA.WRK" "w") )
			  (while (= (atof (substr lref 1 3)) art)
			       (progn
				    (print lref F) ; écriture dans fichier temporaire
				    (setq tampon
					    (strcat (substr lref 1 8) " " 
						 (substr lref 15 4))
				    )
				       ; création de la liste
				    (setq list_ref (cons tampon list_ref) )
				    (setq lref (read-line fich) )
			       )
			  )
			  (close F)
			  (close fich)
	    )
		) ;fin du if
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
;             met en gris le choix de référence
;             si diamêtre nominal non choisi
;-------------------------------------------------------------------------------
(defun testRef( num )        
     (if (and (check_real (setq dnom (get_tile "dnom")) 4 "dnom") 
	   (check_real (setq dnom (get_tile "dnom")) 2 "dnom") 
	 )
      (progn
	     (mode_tile "ref" 0)   ;active
	     (setq dnom (get_tile "dnom"))
	     (setq art (distof (get_tile "dnom"))) 
	     (cond                              ;création de la liste
		  ( (= num  1  ) (lire1RB) )
		  ( (= num  2  ) (lire2RB) )
		  ( (= num  3  ) (lireROT) )
		  ( (= num  4  ) (lireROT2T) )
		  ( (= num  5  ) (lireOBL) )
		  ( (= num  6  ) (lireCNQ) )
		  ( (= num  7  ) (lireCYL) )
		  ( (= num  8  ) (lireBUTSE) )
		  ( (= num  9  ) (lireBUTSESP) )
		  ( (= num  10 ) (lireBUTDE) )
		  ( (= num  11 ) (lireBUTDESP) )
	       ( (= num  12 ) (lireETA) )
	     )
       );fin du progn
       (mode_tile "ref" 1)
     );fin du if
)    
;-------------------------------------------------------------------------------
;           vérifie si un choix a été effectué  
;-------------------------------------------------------------------------------
(defun check_choix()
   (if (read (get_tile "ref_list"))  
     (progn
	     (setq index (atoi index)) 
	     (done_dialog  0)
     )
     (alert "aucun choix effectu!")
   )
)
;-------------------------------------------------------------------------------
;           définit un point temporaire comme point de
;           départ pour la saisie de l'angle
;-------------------------------------------------------------------------------
(defun temp_pt()
    (if (not (setq x_temp (distof x_pt))) (setq x_temp 0.0))
    (if (not (setq y_temp (distof y_pt))) (setq y_temp 0.0))
    (setq pick_pt (list x_temp y_temp))
)
;------------------------------------------------------------------------------
;              affiche la liste déroulante
;------------------------------------------------------------------------------
(defun affiche_liste( num / refbox)
    (cond 
	( (= num 6)  (setq refbox  "lrefSKFcnq") )
	( (= num 12)  (setq refbox  "lrefETA") )
	( T  (setq refbox  "lrefSKF" )   )
    )
    (if (= OK 1)            
       (progn
		(if (not (new_dialog  refbox dcl_id)) (exit))
		; ---** création de la boite de liste déroulante
		(start_list "ref_list")
		(mapcar 'add_list (reverse list_ref))
		(end_list)
		(action_tile "ref_list" "(setq index $value)" )
		(action_tile "accept" "(check_choix)" )
		(start_dialog)
       )
    )
)
;------------------------------------------------------------------------------
;            Boite de dialogue Choix d'un roulement
;------------------------------------------------------------------------------
(defun skf_dlg(indice sld /  x y)
     ;-----------------initialisations ---
     (setq handle 2)
     (setq OK 1)
     (if (not pick_pt) (setq pick_pt (list 0.0 0.0)))
     (setq x_pt (rtos (car pick_pt))
	   y_pt (rtos (cadr pick_pt))  
     )
     (setq dnom (rtos 3.0 2)) 
     (setq inclin (angtos 0.0)) 
     (setq ep (rtos 0.0 2)) 
    ;-------------------------------------
     (if (< (setq dcl_id (load_dialog "lref.dcl")) 0) (exit))
     (setq olderr  *error*
	*error* new_hdle_error)
     (setq sortie 0)
     (while (> handle 1)
	      (new_dialog "SKFdialog" dcl_id)         
		 ; ---** création de la boite de liste déroulante
	      (setq x (dimx_tile "im_rlt"))
	      (setq y (dimy_tile "im_rlt"))
	      (start_image "im_rlt")
	      (slide_image 0 0 x y sld)
	      (end_image)
		; rcupêre la position
	       (defaults) 
	      (if (= 2 handle) (mode_tile "pick_pt" 2) )
	      (action_tile  "pick_pt"     "(done_dialog 2)")
	      (action_tile  "x_pt"        "(do_x_pt)")  
	      (action_tile  "y_pt"        "(do_y_pt)") 
	      (action_tile "angle_pick"       "(done_dialog 3)")
	      (action_tile "rot"        "(do_angle)")
	      (action_tile "e_trait"      "(do_ep)")
	      (action_tile "dnom"         "(do_dnom)(testRef indice)") 
	      (action_tile "ref"          "(affiche_liste indice)" )       
	      (action_tile "accept"       "(check_data)")
	      (action_tile "cancel"       "(done_dialog 0)(setq sortie 1)")
	      
	      (setq handle (start_dialog))
	      (cond
		     ((= 2 handle) ;---------saisie du pt et affichage
			  (initget 1)         ; pas d'entre nulle
			  (setq pick_pt (getpoint "\nPoint d'insertion : "))
			  (setq x_pt (rtos (car pick_pt) 2 4))
			  (setq y_pt (rtos (cadr pick_pt) 2 4))
		     )
		     ((= 3 handle)  ;---------saisie de l'angle
			  (temp_pt)
			  (initget 1)
			  (setq inclin 
			       (angtos (getangle pick_pt "\nAngle/horizontale : "))
			  )
		     )
	  )
     ) ; fin while
	  ; les données sont ok,on continue
		      
    (if (= sortie 1)
		   (prompt "\n...ABANDON du Tracé" )
		    (princ)
     )
     (setq *error* olderr)
     (princ)
)
;------------------------------------------------------------------------------
;            Boite de dialogue Saisie d'un point d'insertion
;------------------------------------------------------------------------------
(defun saisie_dlg( )
     ;-----------------initialisations ---
     (setq handle 2)
     (setq OK 1)
     (if (not pick_pt) (setq pick_pt (list 0.0 0.0)))
     (setq x_pt (rtos (car pick_pt))
	   y_pt (rtos (cadr pick_pt))  
     )
     (setq inclin (angtos 0.0)) 
     (setq ep (rtos 0.0 2)) 
    ;-------------------------------------
     (if (< (setq dcl_id (load_dialog "lref.dcl")) 0) (exit))
     (setq olderr  *error*
		      *error* new_hdle_error)

(setq sortie 0)
     (while (> handle 1)
	   (new_dialog "SaisiePtdlg" dcl_id)         
		 ;init_tiles
	   (mode_tile "z_pt" 1)   ;désactive z_pt
	   (if x_pt 
	       (set_tile "x_pt" x_pt) 
	       (progn
		       (set_tile "x_pt" (rtos 0.00 2))
		       (setq x_pt (rtos 0.00 2))
	       )
	  )
	  (if y_pt 
	       (set_tile "y_pt" y_pt) 
	       (progn
		       (set_tile "y_pt" (rtos 0.00 2))
		       (setq y_pt (rtos 0.00 2))
	       )
	  )
	  (set_tile "rot" inclin)
	  (set_tile "e_trait" ep)
	  (set_tile "error" ">>>> point d'insertion rlt gauche")
	  (if (= 2 handle) (mode_tile "pick_pt" 2) )
	  ;-------------------------
	  (action_tile  "pick_pt"     "(done_dialog 2)")
	  (action_tile  "x_pt"        "(do_x_pt)")  
	  (action_tile  "y_pt"        "(do_y_pt)") 
	  (action_tile "angle_pick"       "(done_dialog 3)")
	  (action_tile "rot"        "(do_angle)")
	  (action_tile "e_trait"      "(do_ep)")
	  (action_tile "accept"       "(check_saisie)")
	  (action_tile "cancel"       "(done_dialog 0)(setq sortie 1)")
	      
	  (setq handle (start_dialog))
	  (cond
		 ((= 2 handle) ;---------saisie du pt et affichage
		     (initget 1)         ; pas d'entre nulle
		     (setq pick_pt (getpoint "\nPoint d'insertion : "))
		     (setq x_pt (rtos (car pick_pt) 2 4))
		     (setq y_pt (rtos (cadr pick_pt) 2 4))
		 )
		 ((= 3 handle)  ;---------saisie de l'angle
		     (temp_pt)
		     (initget 1)
		     (setq inclin 
		       (angtos (getangle  pick_pt "\nAngle/horizontale : ")) 
		     )
		 )
	  )
     );fin du while
	  ; les données sont ok,on continue
		      
    (if (= sortie 1)
		   (prompt "\n...ABANDON du Tracé" )
		    (princ)
     )
     (setq *error* olderr)
     (princ)
)
;-------------------------------------------------------------------------------      
;	parois moulées
;-------------------------------------------------------------------------------
(defun do_diedre()
    (check_diedre (setq angdie $value) "die")
)
;-------------------------------------------------------------------------------
;                vérifie l'angle et retourne la valeur 
;                 ou nil et un message d'erreur
;-------------------------------------------------------------------------------
(defun check_diedre(value coord / nbreOK msg)
  (raz_error)
  (setq msg  (strcat "Donnée " (strcase (substr coord 1 1)) " Incorrecte."))

(cond
    ( (and (setq nbreOK (angtof value))
      )
      (set_tile "error" "")
      (atof (angtos nbreOK))
    )
    (T (set_tile "error" msg) nil)
  )
)
;-------------------------------------------------------------------------------   
;                   action paroi mince
;-------------------------------------------------------------------------------   
(defun do_thin()
    (check_real (setq Ei $value) 4 "mince")  
    (check_real (setq Ei $value) 2 "mince") 
)
;-------------------------------------------------------------------------------   
;                   action paroi  paisse
;-------------------------------------------------------------------------------   
(defun do_thick()
    (check_real (setq Es $value) 4 "epaiss")  
    (check_real (setq Es $value) 2 "epaiss") 
)
;-------------------------------------------------------------------------------
(defun quelle_ft( button2 )          
   (cond
	 ( (= button2 "lame") (setq typfte 0.3)  )
	 ( (= button2 "sph") (setq typfte 0.8)  )
   )
)
;------------------------------------------------------------------------------
;               Boite de dialogue paroi
;------------------------------------------------------------------------------
(defun paroi_dlg( action sld /  x y)
     ;-----------------initialisations ---
     (setq handle 2)
     (setq OK 1)
     (if (not pick_pt) (setq pick_pt (list 0.0 0.0)))
     (setq x_pt (rtos (car pick_pt))
	   y_pt (rtos (cadr pick_pt))  
     )
     (setq inclin (angtos 0.0)) 
     (setq ep (rtos 0.0 2)) 
     (setq Es (rtos 8.0 2))
     (setq Ei (rtos 8.0 2))
     (setq typfte 0.3)   ;lamellaire 
     (setq angdie (angtos 0.0) )
     (setq option nil)
    ;-------------------------------------
     (if (< (setq dcl_id (load_dialog "lref2.dcl")) 0) (exit))
     (setq olderr  *error*
	*error* new_hdle_error)
     (setq sortie 0)
     (while (> handle 1)
	      (new_dialog "paroidialog" dcl_id)         
		 ; ---** création de la boite de liste déroulante
	      (setq x (dimx_tile "im_rlt"))
	      (setq y (dimy_tile "im_rlt"))
	      (start_image "im_rlt")
	      (slide_image 0 0 x y sld )
	      (end_image)
		  ;affichage
	       (mode_tile "z_pt" 1)   ;désactive z_pt
	    (if x_pt 
	       (set_tile "x_pt" x_pt) 
	       (progn
		       (set_tile "x_pt" (rtos 0.00 2))
		       (setq x_pt (rtos 0.00 2))
	       )
	    )
	    (if y_pt 
	       (set_tile "y_pt" y_pt) 
	       (progn
		       (set_tile "y_pt" (rtos 0.00 2))
		       (setq y_pt (rtos 0.00 2))
	       )
	    )
	    (set_tile "rot" inclin)
	    (if (or (/= action "1") (/= action "2"))
		(set_tile "die" angdie)
	    )
	    (set_tile "e_trait" ep)
	    (set_tile "mince" Ei)
	    (set_tile "epaiss" Es)
	       (set_tile "lame" "1")
	    (set_tile "error" ">>>> Saisir le point d'abord.")
	    (cond 
		( (= action "1") 
		      (setq option 1)
		      (mode_tile "fonterad" 1)      ;desactive
		      (mode_tile "die_pick" 1)
		      (mode_tile "die" 1)
		)
		( (= action "2") 
		      (setq option 1)
		      (mode_tile "die_pick" 1)      ;desactive diedre
		      (mode_tile "die" 1)
		)
	    )
	       ;--------
	      (if (= 2 handle) (mode_tile "pick_pt" 2) )
	      (action_tile  "pick_pt"     "(done_dialog 2)")
	      (action_tile  "x_pt"        "(do_x_pt)")  
	      (action_tile  "y_pt"        "(do_y_pt)") 
	      (action_tile "angle_pick"   "(done_dialog 3)")
	      (action_tile "rot"          "(do_angle)")
	      (action_tile "e_trait"      "(do_ep)")

(action_tile "fonterad"     "(quelle_ft $value)" )     
	   (action_tile "mince"        "(do_thin)")
	   (action_tile "epaiss"       "(do_thick)")
	   (action_tile "die_pick"     "(done_dialog 4)")
	      (action_tile "die"          "(do_diedre)")

(action_tile "accept"       "(check_data_paroi)")
	      (action_tile "cancel"       "(done_dialog 0)(setq sortie 1)")
	      
	      (setq handle (start_dialog))
	      (cond
		     ((= 2 handle) ;---------saisie du pt et affichage
			  (initget 1)         ; pas d'entre nulle
			  (setq pick_pt (getpoint "\nPoint d'insertion : "))
			  (setq x_pt (rtos (car pick_pt) 2 4))
			  (setq y_pt (rtos (cadr pick_pt) 2 4))
		     )
		     ((= 3 handle)  ;---------saisie de l'angle
			  (temp_pt)
			  (initget 1)
			  (setq inclin 
			       (angtos (getangle pick_pt "\nAngle/horizontale : "))
			  )
		     )
	       ((= 4 handle)  ;---------saisie de l'angle diedre
			 
			  (initget (+ 1 2 4)) ;interdit entree nulle , 0 , < 0!
			  (setq angdie 
			       (angtos (getangle "\nAngle diêdre : "))
			  )
		     )
	      )
     )
	  ; les données sont ok,on continue
    (if (= sortie 1)
		   (prompt "\n...ABANDON du Tracé" )
		    (princ)
     )
     (setq *error* olderr)
     (princ)
)
;-------------------------------------------------------------------------------
;                 boite de liste diamêtres
;            ecr.lsp    chc.lsp
;-------------------------------------------------------------------------------
(defun liste_diam( )
	  (if (not (new_dialog  "lrefRdP" dcl_id)) (exit))
		; ---** création de la boite de liste déroulante
		(start_list "ref_list")
		(mapcar 'add_list (reverse list_ref))
		(end_list)
		(action_tile "ref_list" "(setq index $value)" )
		(action_tile "accept" "(check_choix)" )
		(start_dialog)
)
;-------------------------------------------------------------------------------   
;  Cette fonction confirme si toutes les entrées sont correctes
;                              ecr.lsp  chc.lsp
;-------------------------------------------------------------------------------   
(defun check_don()
    (cond
      ( (not (setq x_pt 
	       (check_real (get_tile "x_pt") 0 "x_pt")) )
	       (mode_tile "x_pt" 2) 
      ) 
      ( (not (setq y_pt 
	       (check_real (get_tile "y_pt") 0 "y_pt")) )
	       (mode_tile "y_pt" 2) 
      ) 
      ( (not (setq ep 
	       (check_real (get_tile "e_trait") 4 "e_trait")) )
	       (mode_tile "e_trait" 2) 
      ) 
      ( (not (setq inclin 
	       (check_angle (get_tile "rot")  "rot")) )
	       (mode_tile "angle" 2)
      ) 
      (T (done_dialog ) )
    )
) 
;-------------------------------------------------------------------------------
(defun param_pt()
    (setq fpt (getvar "PDMODE") )
    (setq tpt (getvar "PDSIZE") )
    (setvar "PDMODE" 32)
    (setvar "PDSIZE" 5)
    (init)
)
;-------------------------------------------------------------------------------
(defun Restitue()
    (Deplac)
    (setvar "PDMODE" fpt)
    (setvar "PDSIZE" tpt)
    (setvar "APERTURE" cible)
    (Remet_Echo)
    (princ)
)
;-------------------------------------------------------------------------------
;                        stocke le plan courant
;                        passe dans le plan RLT
;------------------------------------------------------------------------------
(defun Init()
    (Supp_echo)
    (setvar "AUNITS" 0)      ;angles décimaux
    (setq pl (getvar "CLAYER"))
    (setq pl (substr pl 1 5))
    (command "PLAN" "IN" "*" "O" "CH" "RLT" "") ;choisit RLT
    (command "ZOOM" "T")
    (command "RESVUE" "" 500)
) 
;------------------------------------------------------------------------------
;                     transfert de rlt dans plan ancien            
;-------------------------------------------------------------------------------
(defun Deplac()
    (command "CHANGER"  (ssget "X" '((8 . "RLT")) ) ""
		       "PR" "P" pl "")
    (command "PLAN" "AC" "*" "CH" pl "")
   (command "ZOOM" "AV")
)
;------------------------------------------------------------------------------

Page de Jean-Paul Molina

Matières

Ressources

Conception assistée

Langages

Flash

Systèmes

Réseaux sociaux

AutoLisp