Exemples Lisp pour Autocad (AutoLisp) Rondelle plate

AutoLisp

boite tracé de rondelle plate

Ce programme permet de paramétrer le tracé de rondelles plates à partir d'un fichier dimensionnel.
Et voici, dans son intégralité, le fichier RONDELLE.DIM.

1.8 2.0 3.5 5.0 6.0 8.0 0.3
2.0 2.2 4.0 5.5 7.0 9.0 0.3
2.2 2.4 4.5 6.0 8.0 10.0 0.5
2.5 2.7 5.0 7.0 10.0 12.0 0.5
3.0 3.25 6.0 8.0 12.0 14.0 0.8
3.5 3.75 7.0 9.0 13.0 15.0 0.8
4.0 4.25 8.0 10.0 14.0 16.0 0.8
5.0 5.25 10.0 12.0 16.0 20.0 1.0
6.0 6.25 12.0 14.0 18.0 24.0 1.2
7.0 7.25 14.0 16.0 20.0 27.0 1.5
8.0 8.25 16.0 18.0 22.0 30.0 1.5
9.0 9.25 18.0 20.0 24.0 30.0 1.5
10.0 10.25 20.0 22.0 27.0 36.0 2.0
11.0 11.5 22.0 24.0 30.0 38.0 2.0
12.0 12.50 24.0 27.0 32.0 40.0 2.5
14.0 14.50 27.0 30.0 36.0 45.0 2.5
16.0 16.50 30.0 32.0 40.0 50.0 3.0
18.0 19.00 32.0 36.0 45.0 55.0 3.0
20.0 21.00 36.0 40.0 50.0 60.0 3.0
22.0 23.00 40.0 45.0 55.0 65.0 3.0
24.0 25.00 45.0 50.0 60.0 70.0 4.0
27.0 28.00 48.0 55.0 65.0 75.0 4.0
30.0 31.00 52.0 60.0 70.0 80.0 4.0
36.0 37.00 60.0 70.0 80.0 90.0 5.0

;--------------------------------------------------------------
;---------- PROGRAMME DE TRACE DE RONDELLES PLATES ------
;------------ Copyright (C) 1987... J-P MOLINA ----------------
;
;------- lref1.dcl fichier associé 
; ------ rondelle.dim fichier dimensionnel
;--------------------------------------------------------------
(defun CatalogRdP(/ ff fich)
  (setq ff (findfile "RONDELLE.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier RONDELLE.DIM non trouvé !")
	   (princ)
	(exit)
	 )
	 (progn
		(setq fich (open ff "r") )
		(setq list_ref nil)
		(while (setq ref (read-line fich))
		   (setq list_ref (cons (substr ref 1 4) list_ref) )
		)
		(close fich)
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
(defun rdPval_initial()
     ;désactive
    (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 la référence")
    (set_tile "M" "1" )
)
;-------------------------------------------------------------------------------
(defun quel_typerdP( button2 ) 
   (cond
	 ( (= button2 "Z")   (setq rdPtype 0) )
	 ( (= button2 "M")   (setq rdPtype 1) )
	 ( (= button2 "L")   (setq rdPtype 2) )
      ( (= button2 "LL")  (setq rdPtype 3) )
   )
) 
;----------------------------------------------------------------
(defun RdP_dialog()
  ;-----------------initialisations ---
     (setq handle 2)
     (CatalogrdP)
     (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 rdPtype 1)
    ;-------------------------------------
    (if (< (setq dcl_id (load_dialog "lref1.dcl")) 0) (exit))
     (setq olderr  *error*
	*error* new_hdle_error)
     (setq sortie 0)
     (while (> handle 1)
	      (new_dialog "rdPdialog" 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 "icorlt(rdp1)" )      ;pour l'instant
	      (end_image) 
	      (rdPval_initial)
	      (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 "rdPrad"       "(quel_typerdP $value)" )
	      (action_tile "ref"          "(liste_diam)" ) ;cf mecadim.lsp       
	      (action_tile "accept"       "(check_don)")   ;.............
	      (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'entrée 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 : "))
		     )
		 )
	      )
     )
	  ; les données sont ok,on continue
     (if (= sortie 1)
		   (prompt "\n...ABANDON du Tracé" )
		    (princ)
     )
     (setq *error* olderr)
     (princ)

)
;----------------------------------------------------------------
(defun DonnRdP( / ff fich)
    (setq ff (findfile "RONDELLE.DIM") )
     (if (= nil ff )
	 (progn
	   (alert "Fichier RONDELLE.DIM non trouvé !")
	   (princ)
	   (exit)
	 )
	 (progn
	     (setq fich (open ff "r"))
	   (if (/= index nil)
	       (progn
		  (setq index (+ index 1) )    ;1ère ligne nulle
		  (repeat index
			  (setq ref (read-line fich))
		  )
		  (close fich)
		  (ConverRdP)
	    )
	       (alert "Pas de référence choisie!")
		);fin du if index
	 );fin du progn
  );fin du if
)
;---------------------------------------------------------------------------
(defun ConverRdP()
	   (setq p (list x_pt y_pt))
	     (setq ang (degrad inclin))        ;inclin
	     (setq trait  ep)         ;Epaisseur du trait

(setq di (atof (substr ref 6 5)))
	  (cond
	    ( (= rdPtype 0)    (setq de (atof (substr ref 12 4))) )
	    ( (= rdPtype 1)    (setq de (atof (substr ref 17 4))) ) 
	    ( (= rdPtype 2)    (setq de (atof (substr ref 22 4))) ) 
	    ( (= rdPtype 3)    (setq de (atof (substr ref 27 4))) ) 
	  )
	  (setq ept (atof (substr ref 32 3)))
	  (SqueletteRdP)
)
;---------------------------------------------------------------------------
(defun SqueletteRdP(/ p1 p2 p3 p4 p5)
	   (IF (AND (/= di nil)
			  (/= de nil)
		    (/= ept nil)
	    )
	    (progn (setq p1 (polar p (+ ang (/ pi 2.0)) (/ di 2.0) ))
		 (setq p2 (polar p (+ ang (/ pi 2.0)) (/ de 2.0) ))
		 (setq p3 (polar p2 ang ept) )
		 (setq p5 (polar p3 (- ang (/ pi 2.0)) de) )
		 (setq p4 (polar p1 ang ept) )
		(supp_echo)
		(dess_rond)
	 )
     )
)
;--------------------------------------------------------------------------
(defun Dess_Rond(/ pl)
    (init)
    (command "POLYLIGN" p1 "LA" (abs trait) "" p2 p3 p4 "clore")
    (command "COPIER" "d" "" p4 p5)
    (command "HACHURES" "u" (+ 45 (* (/ ang pi) 180.0))
				       (/ di 10.0) "n" p3 p5 "")
    (deplac)
    (remet_echo)
)
;----------------------------------------------------------------------------
(defun nettoieRdP()
    (setq p nil) (setq ang nil) (setq ref nil)
    (setq di nil) (setq de nil) (setq ept nil) (setq trait nil)
    (setq a nil)(setq index nil)
)
;---------------------------------------------------------------------------
(defun C:ROND()
	(nettoieRdP)
	(prompt "\n --- Rondelles plates (C) JP MOLINA ---")
	(RdP_dialog)
	(if (/= sortie 1) (DonnrdP) )

(nettoieRdP)
     (princ)
)
;--------------------------------------------------------------------------

Page de Jean-Paul Molina

Matières

Ressources

Conception assistée

Langages

Flash

Systèmes

Réseaux sociaux

AutoLisp