Examples Lisp for Autocad Rondelle grower

AutoLisp

boite tracé de rondelle grower

Programme de tracé de rondelles Grower à partir d'un fichier de dimensions.
Et voici, dans son intégralité, le fichier GROWER.DIM.

3.0 3.2 5.2 1.0 0.6 3.2 5.2 1.0 3.2 6.2 1.5 1.0
3.5 3.7 5.7 1.0 0.6 3.7 5.7 1.0 3.7 6.7 1.5 1.0
4.0 4.3 7.3 1.5 1.0 4.3 7.3 1.5 4.3 8.3 2.0 1.2
5.0 5.3 8.3 1.5 1.0 5.3 8.3 1.5 5.3 10.3 2.5 1.5
6.0 6.4 10.4 2.0 1.2 6.4 10.4 2.0 6.4 12.4 3.0 1.8
7.0 7.4 11.4 2.0 1.2 7.4 11.4 2.0 7.4 13.4 3.0 1.8
8.0 8.4 13.4 2.5 1.5 8.4 13.4 2.5 8.4 15.4 3.5 2.0
9.0 9.4 14.4 2.5 1.5 9.4 14.4 2.5 9.4 17.4 4.0 2.5
10.0 10.5 16.5 3.0 1.8 10.5 16.5 3.0 10.5 18.5 4.0 2.5
12.0 13.0 20.0 3.5 2.0 13.0 20.0 3.5 13.0 23.0 5.0 3.0
14.0 15.0 23.0 4.0 2.5 15.0 23.0 4.0 15.0 25.0 5.0 3.0
16.0 17.0 25.0 4.0 2.5 17.0 25.0 4.0 17.0 29.0 6.0 3.5
18.0 19.0 29.0 5.0 3.0 19.0 29.0 5.0 19.0 31.0 6.0 3.5
20.0 21.0 31.0 5.0 3.0 21.0 31.0 5.0 21.0 35.0 7.0 4.5
22.0 23.0 33.0 5.0 3.0 23.0 33.0 5.0 23.0 37.0 7.0 4.5
24.0 25.0 37.0 6.0 3.5 25.0 37.0 6.0 25.0 39.0 7.0 4.5
27.0 28.0 40.0 6.0 3.5 28.0 40.0 6.0
30.0 31.0 45.0 7.0 4.5 31.0 45.0 7.0

;-------------------------------------------------------------------------------
;--------------- PROGRAMME DE TRACE DE RONDELLES W      --------------------
;------------------- Copyright (C) 1987... J-P MOLINA --------------------------
;				 lref1.dcl    fichier associé 
;				 grower.dim fichier de dimensions
;-------------------------------------------------------------------------------
(defun CatalogW(/ ff fich)
  (setq ff (findfile "GROWER.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier GROWER.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 Wval_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 "W" "1" )
)
;-------------------------------------------------------------------------------
(defun quel_typeW( button2 ) 
   (cond
	 ( (= button2 "WZ")   (setq Wtype 0) )
	 ( (= button2 "W")    (setq Wtype 1) )
	 ( (= button2 "WL")   (setq Wtype 2) )
   )
)
;-------------------------------------------------------------------------------
(defun check_W()
    (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 (test_WL) )
    )
) 
;-------------------------------------------------------------------------------
(defun test_WL()
   ( if (and (= Wtype 2) ( >= index 16) )
       (progn 
	   (set_tile "error" ">>>> Pas de série forte pour cette référence!")
	   (mode_tile "Wrad" 2)
       )
       (done_dialog)
   )
)
;-------------------------------------------------------------------------------
(defun RdP_dialog()
  ;-----------------initialisations ---
     (setq handle 2)
     (CatalogW)
     (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 Wtype 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 "Wdialog" 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(W1)" )      ;pour l'instant
	      (end_image) 
	      (Wval_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 "Wrad"         "(quel_typeW $value)" )
	      (action_tile "ref"          "(liste_diam)" ) ;.....cf mecadim.lsp       
	      (action_tile "accept"       "(check_W)")  
	      (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 DonnW( / ff fich)
    (setq ff (findfile "GROWER.DIM") )
     (if (= nil ff )
	 (progn
	   (alert "Fichier GROWER.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)
		  (ConverW)
	    )
	       (alert "Pas de référence choisie!")
		);fin du if index
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
(defun ConverW()
	     (setq p (list x_pt y_pt))
	     (setq ang (degrad inclin))        ;inclin
	     (setq trait  ep)         ;Epaisseur du trait

(cond
	    ( (= Wtype 0) (reduit) )
	    ( (= Wtype 1) (courant)  ) 
	    ( (= Wtype 2) (forte)  ) 
	  )
	  (SqueletteW)
)
;-------------------------------------------------------------------------------
(defun reduit()
      ; (setq a (atof (substr ref 6 4)))
       (setq b (atof (substr ref 11 4)))
      ; (setq c (atof (substr ref 16 3)))
       (setq e (atof (substr ref 20 3)))
)
;-------------------------------------------------------------------------------
(defun courant()
       ;(setq a (atof (substr ref 24 4)))
       (setq b (atof (substr ref 29 4)))
       ;(setq c (atof (substr ref 34 3)))
       (setq e  (atof (substr ref 34 3)))      ; e = c
)
;-------------------------------------------------------------------------------
(defun forte()
       ;(setq a (atof (substr ref 38 4)))
       (setq b (atof (substr ref 43 4)))
       ;(setq c (atof (substr ref 48 3)))
       (setq e (atof (substr ref 52 3)))
)
;-------------------------------------------------------------------------------
(defun SqueletteW(/ p1 p2 p3 p4 y p5 q q1)
	   (IF (AND (/= b nil) (/= e nil)) 
	   (progn 
	       (setq p1 (polar p (+ ang (/ pi 2.0)) (/ b 2.0) ))
	       (setq p2 (polar p1 ang e) )
		     (setq p3 (polar p2 (- ang (/ pi 2.0)) b ))
		     (setq p4 (polar p1 (- ang (/ pi 2.0)) b ))
	       (setq y (* e (/ (sin (/ pi 6.0)) (cos (/ pi 6.0)))))
		     (setq p5 (polar p (- ang (/ pi 2.0)) y) )
	       (setq q (polar p ang e) )
	       (setq q1 (polar q (+ ang (/ pi 2.0)) y) )
		(supp_echo)
		(dess_W)
	  )
     )
)
;-------------------------------------------------------------------------------
(defun Dess_W()
    (init)
    (command "POLYLIGN" p "LA" (abs trait) "" p1 p2 p3 p4 "clore")
    (command "POLYLIGN" p q1 "")
    (command "POLYLIGN" p5 q "")
    (deplac)
    (remet_echo)
)
;-------------------------------------------------------------------------------
(defun nettoieW()
    (setq p nil) (setq ang nil) (setq ref nil)
     (setq e nil) (setq trait nil)
    (setq b nil)(setq index nil)
)
;-------------------------------------------------------------------------------
(defun C:W()
	(nettoieW)
	(prompt "\n *** Rondelles grower (C) JP MOLINA ***")
	(RdP_dialog)
	(if (/= sortie 1) (DonnW) )   
	   
	(nettoieW)
     (princ)
)
;-------------------------------------------------------------------------------

Page de Jean-Paul Molina

Subjects

Resources

C.A.D.

Langages

Flash

Systems

Social Networks

AutoLisp