Examples Lisp for Autocad Rondelle d'étanchéité SKF

AutoLisp

boite tracé rondelles étanchéïté skf

Programme de tracé de groupement de rondelles d'étanchéïté à partir d'un fichier de dimensions.
Et voici un extrait du fichier SKF_ETA.DIM.

17 35 4 1.0 Z003
17 40 4 1.0 Z203
17 47 5 1.25 Z303
20 42 5 1.25 Z004
20 47 5 1.25 Z204
20 52 5 1.25 Z304
25 47 5 1.25 Z005
25 52 5 1.25 Z205
25 62 6 1.5 Z305
30 55 5 1.25 Z006
30 62 6 1.5 Z206
30 72 6 1.5 Z306

;-------------------------------------------------------------------------------
;--------------- PROGRAMME DE TRACE DE RONDELLES ETANCHES SKF --------
;---------------** Copyright (C) 1987- ... JP MOLINA --------------------------
;				lref1.dcl fichier associé 
;				SKF_ETA.DIM fichier dimensionnel 
;-------------------------------------------------------------------------------
(defun active_sens()
     (mode_tile "sensrad" 0)
     (mode_tile "right" 0)
     (mode_tile "left" 0)
)
;-------------------------------------------------------------------------------
;                  Nbre de couples de rondelles
;                     si nbre=1 désactive le bouton sens
;-------------------------------------------------------------------------------
(defun quel_nbre( button1 )
   (cond                       
	 ( (= button1 "un") (setq nbre 1) (mode_tile "sensrad" 1)    )
	 ( (= button1 "deux") (setq nbre 2) (active_sens)    )
	 ( (= button1 "trois") (setq nbre 3) (active_sens)    )
	 ( (= button1 "quatre") (setq nbre 4) (active_sens)    )
	 ( (= button1 "cinq") (setq nbre 5) (active_sens)    )
   )
)
;-------------------------------------------------------------------------------
;                   Sens de tracé des couples de rondelles
;-------------------------------------------------------------------------------
(defun quel_sens( button2 ) 
   (cond
	 ( (= button2 "right") (setq eps 1)  )
	 ( (= button2 "left") (setq eps -1)  )
   )
)
;------------------------------------------------------------------------------
;              affiche la liste déroulante
;------------------------------------------------------------------------------
(defun aff_liste_ecr()
    (if (= OK 1)            
       (progn
		(if (< (setq dcl_id (load_dialog "lref.dcl")) 0) (exit))
		(new_dialog  lrefETA dcl_id)
		; ---** 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
;-------------------------------------------------------------------------------
(defun ETA_dlg( /  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)) 
     (setq eps 1)
     (setq nbre 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 "etaSKFdialog" 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(eta1)" )
	      (end_image)
		
	      (defaults) 
	      (set_tile "right" "1")
	      (set_tile "un" "1")
	      (if (= nbre 1) (mode_tile "sensrad" 1) (active_sens)  )
	      (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 12 )") 
	      (action_tile "ref"          "(affiche_liste 12 )" ) 
	      (action_tile "nbrerad"      "(quel_nbre $value)" )  
	      (action_tile "sensrad"      "(quel_sens $value)" )     
	      (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'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 ChercheETA( / f)
    (setq p (list x_pt y_pt))
    (setq ang  (degrad inclin))        ;inclin
    (setq trait  ep)         ;Epaisseur du trait

(setq f (open "ETA.WRK" "r") )
    (setq index (+ index 2) )    ;pour éviter la valeur 0
      (repeat index              ; 1 ligne vierge en début de fichier
	   (setq ref (read-line f))
      )
    (close f)
    (ConverETA)
)
;-------------------------------------------------------------------------------
(defun ConverETA()
		      (setq d (atof (substr ref 2 2) ) )
		      (setq de (atof (substr ref 5 3) ) )
		      (setq L (atof (substr ref 9 1) ) )
		      (setq h (atof (substr ref 11 4) ) )
		      (SqueletteETA)
)
;-------------------------------------------------------------------------------
(defun SqueletteETA( / q1 q2 qq1 qq2 qq3 qq4 p1 p2 pp1 pp2 pp3 pp4
		   qa1 qb1 ppa3 ppb3 pa2 pb2 qqa3 qqb3 dist x )
    (If (And (/= d "NIL")
	     (/= de "NIL")
	     (/= L "NIL")
	     (/= h "NIL")
	)
	(progn (setq q (polar p (+ ang pi) L) )
	       (setq q1 (polar q (+ ang (/ pi 2.0)) (/ d 2.0) ) )
	       (setq dist (* h (Tan (/ 85.0 2.0)) ) )
	       (setq qa1 (polar q1 ang (* 2.0 dist) ))
	       (setq qb1 (polar q1 (+ ang (DegRad 85.0)) (* 2.0 dist) ))
	       (setq q2 (polar q (+ ang (/ pi 2.0)) (/ de 2.0) ) )
	       (setq p2 (polar q2 ang L) )
	       (setq pa2 (polar p2 (+ ang pi) (* 2.0 dist) ))
	       (setq pb2 (polar p2 (- ang (DegRad 95.0)) (* 2.0 dist) ))
	       (setq p1 (polar q1 ang L) )
	       (setq pp1 (polar p1 (+ ang (/ pi 2.0)) h) )
	       (setq qq2 (polar q2 (- ang (/ pi 2.0)) h) )
	       (setq qq3 (polar qq2 ang (- L (* 1.1 h)) ) )
	       (setq qqa3 (polar qq3 (+ ang pi) dist) )
	       (setq qqb3 (polar qq3 (- ang (DegRad 95.0)) dist) )
	       (setq pp3 (polar pp1 (+ ang pi) (- L (* 1.1 h))) )
	       (setq ppa3 (polar pp3 ang dist) )
	       (setq ppb3 (polar pp3 (+ ang (DegRad 85.0)) dist) )
	       (setq qq1 (polar q1 (+ ang (DegRad 85.0))
					  (/ (- de d (* 3.0 h)) 2.0)
			 )
	       )
	       (setq pp4 (polar qq1 ang h) )
	       (setq pp2 (polar p2 (- ang (DegRad 95.0))
					  (/ (- de d (* 3.0 h)) 2.0)
			 )
	       )
	       (setq qq4 (polar pp2 (+ ang pi) h))

(setq L (* eps L) ) ; eps=-1 trace vers la gauche

(Supp_Echo)
	       (Dess_eta)
	)
    )
)
;-------------------------------------------------------------------------------
(defun Encore(/ ancien)
    (setq ancien (getvar "SNAPANG") )
    (setvar "SNAPANG" ang)    ; tourne le réticule de ang
			      ; pour le réseau Rect
    (setq ss1 (ssget "X" (list (cons 8 "RLT" ) )) )
    (command "RESEAU" ss1 "" "R" 1  nbre L)
    (setq ss1 nil)   ; libère la mémoire

(setvar "SNAPANG" ancien)
)
;-------------------------------------------------------------------------------
(defun Dess_eta(/ pl )
    (Init)
    (command "POLYLIGN" qq1 "LA" 0 "" pp4 ppb3
			"a" "a" 85 ppa3 "LI" pp1 p1 qa1
			"a" "a" -85 qb1 "CL")
    (command "POLYLIGN" qq4 pp2 pb2
		       "a" "a" 85 pa2 "LI" q2 qq2 qqa3
		       "a" "a" -85 qqb3 "CL")
	   ;***trace du trait lateral ------------------------------
    (command "POLYLIGN" qb1 qq2 "")
    (command "POLYLIGN" pb2 pp1 "")
    ;sélectionne toutes les polylignes du plan RLT
    ;(command "MIROIR" (ssget "X" '((0 . "POLYLINE" ) (8 . "RLT")) ) "" q p "" )
     (setq ss1 (ssget "X" (list (cons 8 "RLT" ) )) )
    (setq ss1 (ssget "X" (list (cons 8 "RLT" ) )) )
    (command "MIROIR" ss1 "" p q "")
    (setq ss1 nil)   ; libère la mémoire

(IF ( > nbre 1) (encore) )
    (Deplac)
    (Remet_Echo)
 )
;-------------------------------------------------------------------------------
(defun nettoieETA()
    (setq p nil) (setq ang nil) (setq art nil) (setq nom nil) (setq ref nil)
    (setq design nil) (setq d nil) (setq de nil) (setq l nil) (setq h nil)
    (setq mark nil) (setq eko nil) (setq a nil) (setq eps nil)
    (setq index nil) (setq button1 nil) (setq button2 nil)
)
;-------------------------------------------------------------------------------
(defun C:ETA()
       (c:nettoie_plan)
       (nettoieETA)
       (prompt "\n-- Rondelles Etanches SKF (C) JP MOLINA ----")
       (ETA_dlg)
       (if (/= sortie 1) (ChercheETA))

(nettoieETA)
       (princ)
)
;-------------------------------------------------------------------------------

Page de Jean-Paul Molina

Subjects

Resources

C.A.D.

Langages

Flash

Systems

Social Networks

AutoLisp