Examples Lisp for Autocad

AutoLisp

Programme de tracé d'écrous hexagonaux suivant plusieurs vues à partir d'un fichier de dimensions.

boite tracé écrou H

boite tracé écrou H <

boite tracé écrou H

Et voici, dans son intégralité, le fichier H.DIM.

6 10 8 13 10 17 12 19 14 22 16 24 18 27 20 30 22 32 24 36 27 41 30 46 36 55 42 65 48 75

;-------------------------------------------------------------------------------
;--------------------------- TRACE D'ECROUS H  -------------------------------
;-------------------- Copyright (C) 1987- ... JP MOLINA ------------------------
;                                    lref1.dcl fichier associé 
;                                    H.dim fichier de dimensions
;                     fichier icorlt.slb pour les images dans les boites de dialogue 
;-------------------------------------------------------------------------------
(defun CatalogECRH(/ ff fich)
   (setq ff (findfile "H.DIM") )
   (if (= nil ff )
	  (progn
	    (alert "Fichier H.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 2) list_ref) )
		)
		(close fich)
	  )
   )
)
;-------------------------------------------------------------------------------
(defun Hval_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 "hache" "1" )
)
;-------------------------------------------------------------------------------
(defun quel_typeH( button2 ) 
   (cond
	 ( (= button2 "hache")   (setq Htype 0) )
	 ( (= button2 "hacheh")  (setq Htype 1) )
	 ( (= button2 "hachem")  (setq Htype 2) )
   )
)               
;-------------------------------------------------------------------------------
(defun ECRH_dialog( / x y )
      ;-----------------initialisations ---
     (setq handle 2)
     (CatalogECRH)
     (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 Htype 0)
    ;-------------------------------------
    (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 "ecrHdialog" 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 image ) 
	      (end_image) 
	      (if (= vue 2)  (mode_tile "Hrad" 1))
	      (Hval_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 "Hrad"         "(quel_typeH $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 DonnECRH( / ff fich)
  (setq ff (findfile "H.DIM") )
  (if (= nil ff )
	 (progn
	   (alert "Fichier H.DIM non trouvé !")
	   (princ)
	   (exit)
	 )
	 (progn
	     (setq fich (open ff "r"))
	     (if (/= index nil)
	       (progn
		       (setq index (1+ index ) )    ;1ère ligne =index 0
		       (repeat index
			       (setq ref (read-line fich))
		       )
		       (close fich)
		       (ConvertECRH)
	       )
	       (alert "Pas de référence choisie!")
		);fin du if index
	 );fin du progn
  );fin du if
)
;-------------------------------------------------------------------------------
(defun ConvertECRH()
	     (setq p (list x_pt y_pt))
	     (setq ang (degrad inclin))        ;inclin
	     (setq trait  ep)         ;Epaisseur du trait

(setq dnom (atof (substr ref 1 2)))
	  (setq a (atof (substr ref 4 2)))
	  (setq D (* 1.15 a) )
	  (cond
	     ( (= Htype 0) (setq h (* 0.8 dnom)) )
	     ( (= Htype 1) (setq h dnom) )
	     ( (= Htype 2) (setq h (* 0.5 dnom)) )
	  )
	  (cond
	   ( (=  vue 0) (SqueletteHFace) )
	   ( (= vue 1) (SqueletteHcote) )
	   ( (= vue 2) (SqueletteHdess) )
	  )
)
;-------------------------------------------------------------------------------
(defun SqueletteHFace( / q c1 p2 q1 q3 xx fl delta p3 p1)
    (If (AND (/= dnom "NIL")
	     (/= a "NIL")
	)
	(progn
	      (setq q (polar p ang (* 0.5 h)) )
	      (setq c1 (polar p ang (* 0.75 D)) )
	      (setq p2 (polar p (+ ang (/ pi 2.0)) (/ (+ D dnom) 4.0)) )
	      (setq q1 (polar q (+ ang (/ pi 2.0)) (/ D 2.0)) )
	      (setq q3 (polar q (+ ang (/ pi 2.0)) (/ dnom 2.0)) )
	      (setq xx (sqrt (- (expt (* 0.75 D) 2.0) (expt (* 0.5 dnom) 2.0))))
	      (setq fl (- (* 0.75 D ) xx) )
	      (setq delta (- (/ h 2.0) fl ))
	      (setq p3 (polar q3 (+ ang pi) delta) )
	      (setq p1 (polar q1 (+ ang pi) delta) )
	      (TraceHFace)
	)
    )
)
;-------------------------------------------------------------------------------
(defun TraceHFace(  )
     (Init)
      ; trace 1/4 contour externe   ;s second pt
      (command "POLYLIGN" q1 "LA" (abs trait) "" p1 "a" "s" p2 p3 "ce" c1 p "")
      (command "POLYLIGN" p p2 "")  ; trait tangent
      (command "POLYLIGN" p3 q3 "") ; trait interne

;sélectionne toutes les polylignes du plan RLT
      ;(command "MIROIR" (ssget "X" '((0 . "POLYLINE" ) (8 . "RLT")) ) "" q q1 "")     ; demi-ecrou
      ;(command "MIROIR" (ssget "X" '((0 . "POLYLINE" ) (8 . "RLT")) ) "" q p "" )     ; ecrou complet
      (setq ss1 (ssget "X" (list (cons 8 "RLT" ) )) )
      (command "MIROIR" ss1 "" q q1 "")
      (setq ss1 (ssget "X" (list (cons 8 "RLT" ) )) )
      (command "MIROIR" ss1 "" q p "")
      (setq ss1 nil)   ; libère la mémoire

(Deplac)
      (Remet_Echo)
)
;-------------------------------------------------------------------------------
;-------------------------------------------------------------------------------
(defun SqueletteHcote( / q p2 p4 q1 q2 xx fl delta p3 p1 p5)
    (If (AND (/= dnom "NIL")
	     (/= a "NIL")
	)
	(progn
	      (setq q (polar p ang (* 0.5 h)) )
	      (setq q1 (polar q (+ ang (/ pi 2.0)) (* 0.5 a) ) )
	      (setq q2 (polar q (- ang (/ pi 2.0)) (* 0.5 a) ) )
	      (setq p2 (polar p (+ ang (/ pi 2.0)) (* 0.25 a) ) )
	      (setq p4 (polar p (- ang (/ pi 2.0)) (* 0.25 a) ) )
	      (setq xx (sqrt (- (expt (* 0.5 D) 2.0) (expt (* 0.25 a) 2.0))))     
	      (setq fl (- (* 0.5 D ) xx) )
	      (setq delta (- (/ h 2.0) fl ))
	      (setq p3 (polar q (+ ang pi) delta) )
	      (setq p1 (polar q1 (+ ang pi) delta) )
	      (setq p5 (polar q2 (+ ang pi) delta) )
	      (TraceHcote)
	)
    )
)
;-------------------------------------------------------------------------------
(defun TraceHcote()
     (Init)
      ; trace contour externe   ;s second pt
      (command "POLYLIGN" q1 "LA" (abs trait) "" p1 "a" "s" p2 p3
				"s" p4 p5 "LI" q2 "")
      (command "POLYLIGN" p4 p2 "")  ; trait tangent
      (command "POLYLIGN" p3 q "") ; trait interne
     ;sélectionne toutes les polylignes du plan RLT
      ;(command "MIROIR" (ssget "X" '((0 . "POLYLINE" ) (8 . "RLT")) ) "" q q1 "")
      (setq ss1 (ssget "X" (list (cons 8 "RLT" ) )) )
      (command "MIROIR" ss1 "" q q1"")
      (setq ss1 nil)   ; libère la mémoire

(Deplac)
      (Remet_Echo)
)
;-------------------------------------------------------------------------------
(defun SqueletteHdess( / q q1 p1 dr)
    (If (AND (/= dnom "NIL")
	     (/= a "NIL")
	)
	(progn
	      (setq q (polar p ang (* 0.5 D)) )
	      (setq q1 (polar p (+ ang (/ pi 3.0)) (* 0.5 D)) )
	      (setq p1 (polar p ang (* 0.5 dnom)) )
	      (setq dr (* D (/ (sqrt 3) 2.0))   )
	      (TraceHdess)
	)
    )
)
;-------------------------------------------------------------------------------
(defun TraceHdess()
     (Init)
      ; trace 1 cote
      (command "POLYLIGN" q "LA" (abs trait) "" q1 "")
      (command "RESEAU" "d" "" "P" p 6 360 "O")
      (command "ANNEAU" (- dr (abs trait)) dr p "")
      (command "ARC" p1 "ce" p "a" 270)
      (Deplac)
      (Remet_Echo)
)
;-------------------------------------------------------------------------------
(defun nettoieH()
    (setq p nil) (setq ang nil)   (setq ref nil)(setq dnom nil) (setq a nil)
    (setq trait nil) (setq index nil) (setq cible nil) (setq Htype nil)
    (setq image nil)  (setq D nil)
)
;----------------------- PROGRAMME PRINCIPAL -----------------------------------
(defun c:H( vue )
    (c:nettoie_plan)
    (nettoieH)
    (prompt "\n------ écrou H  (C) JP MOLINA --")
	  (cond
	   ( (= vue 0) (setq image "icorlt(H1)" ) )
	   ( (= vue 1) (setq image "icorlt(H2)" ) ) ; pour l'instant
	   ( (= vue 2) (setq image "icorlt(H3)" ) )
	  )

(ECRH_Dialog)
    (if (/= sortie 1) (DonnECRH) )
    (nettoieH)
    (setq vue nil)
    (princ)
)
;-------------------------------------------------------------------------------

Page de Jean-Paul Molina

Subjects

Resources

C.A.D.

Langages

Flash

Systems

Social Networks

AutoLisp