Examples Lisp for Autocad

AutoLisp

boite tracé écrou skf

Programme de tracé d'écrous avec ou sans rondelle-frein à partir d'un fichier de dimensions.
Et voici un extrait du fichier SKF_ECR.DIM.

17 24.0 28 5 2.0 1.0
20 26.0 32 6 2.0 1.25
25 32.0 38 7 2.0 1.25
30 38.0 45 7 2.0 1.25
35 44.0 52 8 2.0 1.25
40 50.0 58 9 2.5 1.25
45 56.0 65 10 2.5 1.25
50 61.0 70 11 2.5 1.25

;-------------------------------------------------------------------------------
;--------------------  TRACE D'ECROUS ET RONDELLES FREIN SKF   ------------
;-------------------- Copyright (C) 1987- ... JP MOLINA -----------------------
;                                         lref.dcl     fichier associé 
;                                         SKF_ECR.DIM   fichier dimensionnel 
;-------------------------------------------------------------------------------
(defun CatalogECR(/ ff fich)
   (setq ff (findfile "SKF_ECR.DIM") )
   (if (= nil ff )
	  (progn
	    (alert "Fichier SKF_ECR.DIM non trouvé !")
	    (princ)
	    (exit)
	  )
	  (progn
		(setq list_ref nil)
		(setq fich (open ff "r"))
		(while (setq ref (read-line fich))
		     (setq list_ref (cons (substr ref 1 3) list_ref) )
		)
		(close fich)
	  )
   )
)
;-------------------------------------------------------------------------------
(defun val_par_def()
    ;désactive
    (mode_tile "z_pt" 1)   ;désactive z_pt
    (set_tile "rdf" "1")   ; coche la case rondelle frein
    (setq ring "1")        ; initialise ring à 1
    (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")
)
;-------------------------------------------------------------------------------
(defun ECR_dialog()
      ;-----------------initialisations ---
     (setq handle 2)
     (CatalogECR)
     (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 "ecrSKFdialog" 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(ecr1)" )
	      (end_image)

(val_par_def)
	   (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 "rdf"          "(setq ring $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 DonnECR( / ff fich)
  (setq ff (findfile "SKF_ECR.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier SKF_ECR.DIM non trouvé !")
	   (princ)
	   (exit)
	 )
	 (progn
		(setq fich (open ff "r") )
		(if (/= index nil)
		     (progn
			     (setq index (1+ index ) )    ;pour éviter la valeur 0
			     (repeat index              ; 1 ligne vierge en début de fichier
			          (setq ref (read-line fich))
			     )
			     (close fich)
			     (TestECR)
			     (ConverECR)
		     )
		     (alert "Pas de référence choisie!")
		);fin du if index
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
(defun TestECR()
       (IF (= (substr ref 23 4) "")
	   (progn
		(alert "Pas de Rondelle frein pour ce diamêtre!")
		(setq ring "0")
	   )
	)
)
;-------------------------------------------------------------------------------
(defun ConverECR()
	     (setq p (list x_pt y_pt))
	     (setq ang (degrad inclin))        ;inclin
	     (setq trait  ep)         ;Epaisseur du trait

(setq arg "NIL")
	     (setq dnom (atof (substr ref 1 3) ) )
	     (setq d1 (atof (substr ref 5 5) ) )
	     (setq d3 (atof (substr ref 11 3) ) )
	     (setq B (atof (substr ref 15 2) ) )
	     (setq h (atof (substr ref 18 4) ) )
	     (setq ring (atoi ring))
	  (if (= 1 ring)   ; rondelle frein
		 (progn
		       (setq ep (atof (substr ref 23 4) ) )
		       (setq panc p)
		       (setq p (polar panc ang ep) )
		       (setq arg "OK")
		 )
	     )
	     (SqueletteECR)
)
;-------------------------------------------------------------------------------
(defun SqueletteECR( / q p1 p2 p6 pp6 p4 p5 x p7 pp4 p3 po1 )
    (If (And (/= dnom "NIL")
	     (/= d1 "NIL")
	     (/= d3 "NIL")
	     (/= B  "NIL")
	     (/= h  "NIL")
	)
	(progn (setq q (polar p ang B))
	       (setq p1 (polar p (+ ang (/ pi 2.0)) (/ dnom 2.0) ) )
	       (setq p2 (polar p (+ ang (/ pi 2.0)) (/ d1 2.0) ) )
	       (setq p6 (polar q (+ ang (/ pi 2.0)) (/ d3 2.0) ) )
	       (setq pp6 (polar p6 (+ ang pi) B))
	       (setq p4 (polar p6 (- ang (/ pi 2.0)) h) )
	       (setq p5 (polar p1 ang b) )
	       (setq x (/ (- d3 d1) 2.0  (sqrt 3.0) ) )
	       (setq p7 (polar p6 (+ ang pi) (- b x)) )
	       (setq pp4 (polar p4 (+ ang pi) b) )
	       (setq p3 (inters p2 p7 p4 pp4 nil) )
	       (setq po1 (polar p1 (- ang (/ pi 2.0)) dnom) )
	       (Supp_Echo)
	       (Dess_Ecr arg)
	)
    )
)
;-------------------------------------------------------------------------------
(defun Rd-Frein(/ epa q1 q2 q3 q7)
	  (setq epa (/ ep 2.0) )
	  (setq q1 (polar p1 (+ ang pi) epa))
	  (setq q2 (polar p2 (+ ang pi) epa))
	  (setq q3 (polar p2 (+ ang (* pi (/ 5.0 6.0))) epa))
	  (setq q7 (polar p7 (+ ang (* pi (/ 5.0 6.0))) epa))
	  (command "POLYLIGN" q1 "LA" ep "" q2 "a" "a" -30 q3 "LI" q7 "")
)
;-------------------------------------------------------------------------------
(defun HachurageECR(arg1 arg2)
    (command "HACHURES" "U" arg1 (/ B 5.0) "" arg2 "")
)
;-------------------------------------------------------------------------------
(defun Dess_Ecr(arg / cible pos pl ent1)
    (Init)
	   ;****** Trace de l'ecrou --------------------***
    (command "POLYLIGN" p1 "LA" (abs trait) "" p2 p3 p4 p5 "C")
    (setq ent1 (entlast))
    (command "POLYLIGN" p3 p7 p6 p4 "")
    (IF (= arg "OK") (Rd-Frein) )

;(command "MIROIR"  (ssget "X" '((0 . "POLYLINE" ) (8 . "RLT")) ) "" p q "")
    (setq ss1 (ssget "X" (list (cons 8 "RLT" ) )) )
    (command "MIROIR" ss1 "" p q "")
    (setq ss1 nil)   ; libère la mémoire

(setq pos (+ (radeg ang) 45 ) )
    (setq cible (getvar "APERTURE") )
    (setvar "APERTURE" 1)
    (HachurageECR pos ent1)
    (HachurageECR pos po1)
    (Deplac)
    (setvar "APERTURE" cible)
    (Remet_Echo)
 )
;-------------------------------------------------------------------------------
(defun nettoieECR()
    (setq p nil) (setq ang nil) (setq art nil) (setq nom nil) (setq ref nil)
    (setq design nil) (setq dnom nil) (setq d3 nil) (setq B nil) (setq d1 nil)
    (setq h nil) (setq ep nil) (setq panc nil) (setq csta nil) (setq trait nil)
    (setq mark nil) (setq eko nil) (setq a nil)(setq index nil)
    (setq arg1 nil) (setq arg2 nil) (setq arg nil)(setq cible nil)
)
;-------------------------------------------------------------------------------
(defun C:ECR()
       (c:nettoie_plan)
       (nettoieECR)
       (prompt "\n**** Ecrou SKF avec/sans rondelle frein *(C) JP MOLINA ---")
    
       (ECR_dialog)
       (if (/= sortie 1) (DonnEcr) )
       (nettoieECR)
       (princ)
)
;----------------------------------------------------------------------

Page de Jean-Paul Molina

Subjects

Resources

C.A.D.

Langages

Flash

Systems

Social Networks

AutoLisp