;;==========================================================================================
;;os_gewinde_aussen-ho-test.lsp
;; os / 16.1.2006 jack

(sd-defdialog 'innengewinde-ho
	:toolbox-button t  							;; Wird in Werkzeugliste eingetragen
	:dialog-title "innengewinde-ho"	  					;; Überschrift 
	:variables  				
     '(
	(ACHSEN-FEEDBACK)
	(ALLES)
	(RICHTUNG)
	(MITTELPUNKT)
	
	(M_REGEL_GEW	:value-type :boolean
			:toggle-type :wide-toggle
			:initial-value t
			:title "Metr. Regelgewinde"
			:after-input
			  (progn (sd-set-variable-status 'STEIGUNG_F :enable nil)
				 (sd-set-variable-status 'STEIGUNG :enable t)
				 (sd-set-variable-status 'UMKEHREN :enable nil)
				 (setf FLAECHE nil)
				 (sd-end-feedback ACHSEN-FEEDBACK)
			  );;progn
	);;M_REGEL_GEW
	(M_FEIN_GEW	:value-type :boolean
			:toggle-type :wide-toggle
			:title "Metr. Feingewinde"
			:after-input
			  (progn (sd-set-variable-status 'STEIGUNG_F :enable t)
				 (sd-set-variable-status 'STEIGUNG :enable nil)
				 (sd-set-variable-status 'UMKEHREN :enable nil)
				 (setf FLAECHE nil)
				 (sd-end-feedback ACHSEN-FEEDBACK)
			  );;progn
	);;M_FEIN_GEW

	(RECHTS_GEW	:value-type :boolean
			:initial-value t
			:toggle-type :grouped-toggle
			:title "Rechts"
	);;RECHTS_GEW
	(LINKS_GEW	:value-type :boolean
			:toggle-type :grouped-toggle
			:title "Links"
	);;LINKS_GEW
	("Gewindeflaeche")
	(FLAECHE	:value-type :face
			:title "Zyl.-Flaeche"
			:prompt-text "Bitte Zylinderflaeche eingeben"
			:check-function Eingabe_flaeche_pruefen
			:after-input 
			(progn
			 (sd-end-feedback ACHSEN-FEEDBACK)
			 (sd-set-variable-status 'UMKEHREN :enable t) 
			 (Gewinde-definieren)
			);;progn
	            );;FLAECHE ende
	;;("Fasenkante(n)")
	;;(KANTE		:value-type :edge
	;;		:multiple-items t
	;,		:title "Kante(n)"
	;;		:check-function Eingabe_kante_pruefen			
	;;		:prompt-text "Bitte Kante für Fase angeben")
	;; ("Gewinderichtung")
	;;(UMKEHREN	:title "Umkehren"
	;;		:toggle-type :wide-toggle
	;;		:initial-enable nil
	;;		:push-action (Richtung-wechseln))




	("Nenndurchmesser")
	;;(DURCHMESSER 	:title "M"
      (gewindedurchmesser    	:title "M"

			:value-type :display-only
			:initial-value 0
			:display-units :length)
     

	("Steigung fuer Regelgewinde")
	(STEIGUNG 	:title "Steigung"
			:value-type :display-only
			:initial-value 0
			:display-units :length)
	("Steigung fuer Feingewinde")
	(STEIGUNG_F 	:title "Steigung"
			:prompt-text "Steigung waehlen"
			:range (0)
			:initial-enable nil
			:display-units :length
			:after-input (setf STEIGUNG STEIGUNG_F))	


      );;variables

    :mutual-exclusion '((M_REGEL_GEW M_FEIN_GEW) (RECHTS_GEW LINKS_GEW))

    :ok-action '(Gewinde-erstellen)

    :cancel-action '(sd-end-feedback ACHSEN-FEEDBACK)
 
    :local-functions
     '(
	(Gewinde-definieren ()
         (setf	ALLES		(sd-inq-geo-props FLAECHE :dest-space :global)
         	DURCHMESSER	(* 2 (sd-cylinder-radius ALLES))
               
       		MITTELPUNKT	(sd-cylinder-center ALLES)
		RICHTUNG	(sd-cylinder-axis-dir ALLES)
		ACHSEN-FEEDBACK (sd-start-direction-feedback :point MITTELPUNKT :direction RICHTUNG :disc t :color 0,0,1)
	 );;setf



         (if M_REGEL_GEW
          (progn
	   (case DURCHMESSER
	 
            (1.00  (setf STEIGUNG 0.25))
	     (1.20  (setf STEIGUNG 0.25))
	     (1.60  (setf STEIGUNG 0.35))
           (1.60  (setf STEIGUNG 0.4))  ;;M2
	    (2.10  (setf STEIGUNG 0.45))  ;;M2.5
	    (2.50  (setf STEIGUNG 0.5))   ;;M3
          (3.20  (setf STEIGUNG 0.7))   ;;M4

	    (3.30  (setf STEIGUNG 0.7))   ;;M4
	    (4.20  (setf STEIGUNG 0.8))   ;;M5
          (4.30  (setf STEIGUNG 0.8))   ;;M5

	    (5.00  (setf STEIGUNG 1.0))   ;;M6
	    (6.80  (setf STEIGUNG 1.25))  ;;M8 stanzen
          (6.90  (setf STEIGUNG 1.25))   ;;M8 lasern
	    (8.20 (setf STEIGUNG 1.5))   ;;M10
	    (10.20 (setf STEIGUNG 1.75))  ;;M12
	    (14.00 (setf STEIGUNG 2.0))   ;;M16
	    (17.50 (setf STEIGUNG 2.5))   ;;M20
	    (24.00 (setf STEIGUNG 3.0))   ;;M24
	    (30.0 (setf STEIGUNG 3.5))   ;;M30
	    (36.0 (setf STEIGUNG 4.0))
	    (42.0 (setf STEIGUNG 4.5))
	    (48.0 (setf STEIGUNG 5.0))
	    (56.0 (setf STEIGUNG 5.5))
	    (64.0 (setf STEIGUNG 6.0))
	    (otherwise (setf STEIGUNG 0))
	   );;case
          );;progn
	  (progn
	   (case DURCHMESSER           ;; für MF feingewinde
	    (2.0  (sd-set-range 'STEIGUNG_F' (0.25)))
	    (3.0  (sd-set-range 'STEIGUNG_F' (0.25)))
	    (4.0  (sd-set-range 'STEIGUNG_F' (0.2 0.35)))
	    (5.0  (sd-set-range 'STEIGUNG_F' (0.25 0.5)))
	    (6.0  (sd-set-range 'STEIGUNG_F' (0.25 0.5 0.75)))
	    (8.0  (sd-set-range 'STEIGUNG_F' (0.25 0.5 1)))
	    (10.0 (sd-set-range 'STEIGUNG_F' (0.25 0.5 1)))
	    (12.0 (sd-set-range 'STEIGUNG_F' (0.35 0.5 1)))
	    (16.0 (sd-set-range 'STEIGUNG_F' (0.5 1 1.5)))
	    (20.0 (sd-set-range 'STEIGUNG_F' (1 1.5)))
	    (24.0 (sd-set-range 'STEIGUNG_F' (1.5 2)))
	    (30.0 (sd-set-range 'STEIGUNG_F' (1.5 2)))
	    (36.0 (sd-set-range 'STEIGUNG_F' (1.5 2)))
	    (42.0 (sd-set-range 'STEIGUNG_F' (1.5 2)))
	    (48.0 (sd-set-range 'STEIGUNG_F' (1.5 2)))
	    (56.0 (sd-set-range 'STEIGUNG_F' (1.5 2)))
	    (64.0 (sd-set-range 'STEIGUNG_F' (2)))
	    (otherwise (setf STEIGUNG_F 0))
	   );;case
	  );;progn
	 );;if 
	;; ------------anfang 17.1.2006 jack

 (if M_REGEL_GEW
          (progn
	   (case DURCHMESSER
	       (1.0  (setf gewindedurchmesser 1))
	     (1.20  (setf gewindedurchmesser 1))
	     (1.60  (setf gewindedurchmesser 2))  ;;M2
	    (2.10  (setf gewindedurchmesser 2.5))  ;;M2.5
	    (2.50  (setf gewindedurchmesser 3))   ;;M3 
	    (3.20  (setf gewindedurchmesser 4))   ;;M4
           (3.30  (setf gewindedurchmesser 4))   ;;M4

	    (4.20  (setf gewindedurchmesser 5))   ;;M5
           (4.30  (setf gewindedurchmesser 5))   ;;M5
	    (5.00  (setf gewindedurchmesser 6))   ;;M6
	    (6.80  (setf gewindedurchmesser 8))  ;;M8 stanzen
          (6.90  (setf gewindedurchmesser 8))   ;;M8 lasern
	    (8.20 (setf gewindedurchmesser 10))   ;;M10
	    (10.20 (setf gewindedurchmesser 12))  ;;M12
	    (14.00 (setf gewindedurchmesser 16))   ;;M16
	    (17.50 (setf gewindedurchmesser 20))   ;;M20
	    (24.00 (setf gewindedurchmesser 24))   ;;M24
	    (30.00 (setf gewindedurchmesser 30))   ;;M30
	    (36.00 (setf gewindedurchmesser 36))
	    (42.0 (setf gewindedurchmesser 42))
	    (48.0 (setf gewindedurchmesser 48))
	    (56.0 (setf gewindedurchmesser 56))
	    (64.0 (setf gewindedurchmesser 64))
	    (otherwise (setf gewindedurchmesser 0))
	   );;case
          );;progn
	  (progn
	   (case DURCHMESSER
	    (2.0  (sd-set-range 'STEIGUNG_F' (0.25)))
	    (3.0  (sd-set-range 'STEIGUNG_F' (0.25)))
	    (4.0  (sd-set-range 'STEIGUNG_F' (0.2 0.35)))
	    (5.0  (sd-set-range 'STEIGUNG_F' (0.25 0.5)))
	    (6.0  (sd-set-range 'STEIGUNG_F' (0.25 0.5 0.75)))
	    (8.0  (sd-set-range 'STEIGUNG_F' (0.25 0.5 1)))
	    (10.0 (sd-set-range 'STEIGUNG_F' (0.25 0.5 1)))
	    (12.0 (sd-set-range 'STEIGUNG_F' (0.35 0.5 1)))
	    (16.0 (sd-set-range 'STEIGUNG_F' (0.5 1 1.5)))
	    (20.0 (sd-set-range 'STEIGUNG_F' (1 1.5)))
	    (24.0 (sd-set-range 'STEIGUNG_F' (1.5 2)))
	    (30.0 (sd-set-range 'STEIGUNG_F' (1.5 2)))
	    (36.0 (sd-set-range 'STEIGUNG_F' (1.5 2)))
	    (42.0 (sd-set-range 'STEIGUNG_F' (1.5 2)))
	    (48.0 (sd-set-range 'STEIGUNG_F' (1.5 2)))
	    (56.0 (sd-set-range 'STEIGUNG_F' (1.5 2)))
	    (64.0 (sd-set-range 'STEIGUNG_F' (2)))
	    (otherwise (setf STEIGUNG_F 0))
	   );;case
	  );;progn
	 );;if 


	);;Gewinde-definieren




	(Gewinde-erstellen ()
	 (if (/= STEIGUNG 0)
	   (progn
	    (sd-call-cmds
	     (progn
	      (sd-define-thread FLAECHE
 	        :nominal-diameter DURCHMESSER
              ;;:core-diameter (* 1.1764  DURCHMESSER)
              :core-diameter (* 1  gewindedurchmesser)

 	        :pitch STEIGUNG
 	        :thread-type :OUTER
 	        :thread-unit :METRIC
 	        :thread-color (sd-color-to-rgb 16753049)
 	        :thread-hand (if RECHTS_GEW :RIGHT-HAND :LEFT-HAND)
 	        :thread-profile (if M_REGEL_GEW :M :MF)
 	        :include-chamfer T
 	        :thread-direction RICHTUNG
 	        :thread-name (if M_REGEL_GEW
 	        		(format nil "M~a" gewindedurchmesser)
 	      			(format nil "M~ax~a" (round gewindedurchmesser) (oli::sd-num-to-string STEIGUNG_F 2))
 	      		     );;if
 	      );;sd-define-thread
 	      
 	      ;;Fase(n) erstellen
 	     ;; (chamfer KANTE
	     ;;   :check
	     ;;   :nolabel_fdbk
	     ;;   :new_distance (/ (- DURCHMESSER (* 0.85 DURCHMESSER)) 2)
	     ;; );;chanfer
	      
	      ;;Beschriften
	      (if (= 0 (- gewindedurchmesser (round gewindedurchmesser)))
	          (setf gewindedurchmesser (round gewindedurchmesser))
	      );;if
	      (if (= 0 (- STEIGUNG_F (round STEIGUNG_F)))
	          (setf STEIGUNG_F (round STEIGUNG_F))
	      );;if
                (Cocreate_3d_note
                	:action :create
	    	:items FLAECHE
	    	:note (if M_REGEL_GEW
	    	       	  (if RECHTS_GEW
	    	       	      (format nil "M~a" gewindedurchmesser)
	        	      (format nil "M~a-LH" gewindedurchmesser)
	        	  );;if
	    	       	  (if RECHTS_GEW	          				
	        	      (format nil "M~ax~a" (round gewindedurchmesser) (oli::sd-num-to-string STEIGUNG_F 2))
	        	      (format nil "M~ax~a-LH" (round gewindedurchmesser) (oli::sd-num-to-string STEIGUNG_F 2))
	        	  );;if	          			  
	              );;if
	      );;cocreate_3d_note
	     );;progn	    
	    );;sd-call-cmds
	   );;progn
	   (if M_REGEL_GEW
		(display (format nil "~A ist kein Metrisches Gewinde" gewindedurchmesser))
		(display "Es wurde keine Steigung gewaehlt!")
	   );;if
	 );;if
         (sd-end-feedback ACHSEN-FEEDBACK)
        );;Gewinde-erstellen

	;; Richtung wechseln
	(Richtung-wechseln ()
	  (sd-end-feedback ACHSEN-FEEDBACK)
	  (setf RICHTUNG (make-gpnt3d	:x (* -1 (gpnt3d_x RICHTUNG))
					:y (* -1 (gpnt3d_y RICHTUNG))
					:z (* -1 (gpnt3d_z RICHTUNG)))
		ACHSEN-FEEDBACK (sd-start-direction-feedback :point MITTELPUNKT :direction RICHTUNG :disc t :color 0,0,1))
	);;Richtung-wechseln
	
	;; Eingabe auf Geo (Zylinder) und gueltige Durchmesser fuer Regel- bzw. Feingewinde pruefen
	(Eingabe_flaeche_pruefen (I)
	 (if (sd-cylinder-p (SD-INQ-GEO-PROPS I))
	     (progn
		(setf DURCHMESSER (* 2 (sd-cylinder-radius (sd-inq-geo-props I :dest-space :global))))
		(if M_REGEL_GEW
		 (progn
		  (case DURCHMESSER
		   ((1.00 1.60 2.10 2.50 3.20 3.30 4.20 4.30 5.00  6.80 6.90  8.20 10.20 14.00 17.50 24.00 30.00 36.00 42.0 48.0 56.0 64.0) :ok)
		   (otherwise (values :error (format nil "~a ist kein Metrisches Gewindekernloch " DURCHMESSER)))
		  );;case
		 );;progn		
		 (progn
		  (case DURCHMESSER
		   ((2.0 3.0 4.0 5.0 6.0 8.0 10.0 12.0 16.0 20.0 24.0 30.0 36.0 42.0 48.0 56.0 64.0) :ok)
		   (otherwise (values :error (format nil "~a ist kein Metrisches Feingewinde" DURCHMESSER)))
		  );;case
		 );;progn
	        );;if
	     );;progn
	     (values :error "Das ist keine Zylinderflaeche!")
	 );;if
	);Eingabe_flaeche_pruefen

	;; Eingabe auf Geo (Kreiskante) pruefen
	;;(Eingabe_kante_pruefen (I)
	;; (if  (sd-circle-p (sd-inq-geo-props I :dest-space :global))
	 ;;     :ok
	 ;;     (values :error "Das ist keine Kreiskante!")
	;; );;if
 	;;);;Eingabe_kante_pruefen
   );;local-functions

);;sd-defdialog