;;=================================================================================================================================
;; os_gewindebolzen.lsp
;; V1.0 os / 18.03.2004
;; V2.0	os / 17.09.2004 - metr. Feingewinde hinzu
;;=================================================================================================================================

(in-package :GD-package)
(use-package :OLI)

(sd-defdialog 'os_gewindebolzen
  :dialog-title "Gewindebolzen"
  ;:toolbox-button nil
  :variables '(

   (FLAECHE)
   (ALLES)	
   (RADIUS)	
   (RICHTUNG)
   (ACHSEN-FEEDBACK)
   (K_ALLES)
   (K_MITTELPUNKT)
   (K_RADIUS)
   (K_V-RICHTUNG)
   (K_ACHSEN-R)
   (K_DURCHMESSER)
   
   (TEIL	:value-type :part-incl-new
		:modifies :contents 
		:title "Teil"
		:prompt-text "Teil angeben")

   (AKT_WP	:value-type :wp
		:title "AE"
		:initial-enable nil
		:prompt-text "AE angeben.")

   ("Freistich Form")
   (FORM_A	:value-type :boolean
		:initial-value t
		:toggle-type :grouped-toggle
		:size :third
		:title "A")

   (FORM_B	:value-type :boolean
		:toggle-type :grouped-toggle
		:size :third
		:title "B")

   (FREIST_N	:value-type :boolean
		:toggle-type :grouped-toggle
		:size :third
		:title "ohne")

   ("Gewinde")

   (GEWINDE_ART :title "Art"
   		:size :third
   		:expand-shrink ((M_REGEL) (M_FEIN))
   		:expand-shrink-range ((1 :label "Metrisch")
   				      (2 :label "Metr. Feingew")))

   (M_REGEL	:title "Bez."
		:size :third
		:range ("M1" "M1,2" "M1,6" "M2" "M2,5" "M3" "M4" "M5" "M6" "M8" "M10" "M12" "M16" "M20" "M24" "M30");; "M36" "M42" "M48" "M56" "M64")
		:initial-value "M4"
		:prompt-text "Gewindedurchmesser w�hlen")

   (M_FEIN	:title "Bez."
		:size :third
		:range ("M2x0,25" "M3x0,25" "M4x0,2" "M4x0,35" "M5x0,25" "M5x0,5" "M6x0,25" "M6x0,5" "M6x0,75" "M8x0,25" "M8x0,5" "M8x1"
			"M10x0,25" "M10x0,5" "M10x1" "M12x0,35" "M12x0,5" "M12x1" "M16x0,5" "M16x1" "M16x1,5" "M20x1" "M20x1,5" "M24x1,5" "M24x2"
			"M30x1,5" "M30x2");; "M36x1,5" "M36x2" "M42x1,5" "M42x2" "M48x1,5" "M48x2" "M56x1,5" "M56x2" "M64x2")
		:initial-value "M4x0,35"
		:prompt-text "Gewindedurchmesser w�hlen")

   (RECHTS_GEW	:value-type :boolean
		:initial-value t
		:toggle-type :grouped-toggle
		:title "Rechts")

   (LINKS_GEW	:value-type :boolean
		:toggle-type :grouped-toggle
		:title "Links")

   (GEW_L	:value-type :length
		:title "Bolzenl�nge"
		:prompt-text "Bolzenl�nge eingeben.")

   ("Fangen")

   (PKT_3D	:value-type :boolean
		:initial-value t
		:toggle-type :grouped-toggle
		:after-input
			(progn	(sd-set-variable-status 'KANTE :enable t)
				(sd-set-variable-status 'PUNKT :enable nil)
				(sd-set-variable-status 'AKT_WP :enable nil)				
				(setf PUNKT nil)
			);;progn
		:title "Kreis Mitte")

   (PKT_2D	:value-type :boolean
		:toggle-type :grouped-toggle
		:next-variable (if PKT_2D 'PUNKT)
		:after-input
			(progn	(sd-set-variable-status 'PUNKT :enable t)
				(sd-set-variable-status 'KANTE :enable nil)
				(sd-set-variable-status 'AKT_WP :enable t)
				(sd-set-variable-status 'UMKEHREN :enable nil)
				(sd-end-feedback ACHSEN-FEEDBACK)
				(setf KANTE nil)
			);;progn
		:title "2D Punkt")

   (KANTE	:value-type :edge
		:title "Zyl.-Kante"
		:check-function Eingabe_kante_pruefen
		:after-input (progn
				(sd-end-feedback ACHSEN-FEEDBACK)
				(Kantenproperties)
				(sd-set-variable-status 'UMKEHREN :enable t)
			     );;progn
		:prompt-text "Zylinderkante auswaehlen")

   (UMKEHREN	:title "Umkehren"
		:toggle-type :wide-toggle
		:initial-enable nil
		:push-action (Achsenrichtung-wechseln))

   (PUNKT	:value-type :point-2d
		:title "2D Punkt"
		:initial-enable nil
		:prompt-text "2D-Punkt waehlen")

   (next	:push-action (Gewindebolzen-erstellen)
		:next-variable (if PKT_3D
	      			  'KANTE
	      			  'PUNKT
	      		        ))


  );;variables

  :mutual-exclusion '((FORM_A FORM_B FREIST_N) (RECHTS_GEW LINKS_GEW) (PKT_3D PKT_2D))

  :local-functions '(
    (Gewindebolzen-erstellen ()
      (sd-call-cmds
       (progn
        (setf AKT_WP (sd-inq-curr-wp))
	;;Arbeitsebene erstellen und positionieren
	(if PKT_3D
	  (create_workplane :new :name "tmp-Ae" :pt_dir :origin K_MITTELPUNKT
			    :normal K_V-RICHTUNG :u_dir K_ACHSEN-R)
	  (progn             
             (create_workplane :copy :source AKT_WP :name "AE_tmp" :owner "/")
             (slide_wp_origin (sd-inq-curr-wp) PUNKT)
             (position_wp :workplane (sd-inq-curr-wp) :rotate :axis :v :rotation_angle (/ pi -2))
          );;progn
        );;if
             
        ;;Profil und H-Geo loeschen
        (sd-call-cmds (delete_2d :current_wp :edge_2d :all_2d) :failure nil)
        
        ;;==========================
	(case GEWINDE_ART
	    ;; 1=metrisches Regelgewinde
	    (1  (cond
	    	 ((string= M_REGEL "M1")	(setf GEW_D 1.0   STEIGUNG 0.25))
	    	 ((string= M_REGEL "M1,2")      (setf GEW_D 1.2   STEIGUNG 0.25))
	    	 ((string= M_REGEL "M1,6")      (setf GEW_D 1.6   STEIGUNG 0.35))
	    	 ((string= M_REGEL "M2")        (setf GEW_D 2.0   STEIGUNG 0.4))
	    	 ((string= M_REGEL "M2,5")      (setf GEW_D 2.5   STEIGUNG 0.45))
	    	 ((string= M_REGEL "M3")        (setf GEW_D 3.0   STEIGUNG 0.5))
	    	 ((string= M_REGEL "M4")        (setf GEW_D 4.0   STEIGUNG 0.7))
	    	 ((string= M_REGEL "M5")        (setf GEW_D 5.0   STEIGUNG 0.8))
	    	 ((string= M_REGEL "M6")        (setf GEW_D 6.0   STEIGUNG 1.0))
	    	 ((string= M_REGEL "M8")        (setf GEW_D 8.0   STEIGUNG 1.25))
	    	 ((string= M_REGEL "M10")       (setf GEW_D 10.0  STEIGUNG 1.5))
	    	 ((string= M_REGEL "M12")       (setf GEW_D 12.0  STEIGUNG 1.75))
	    	 ((string= M_REGEL "M16")       (setf GEW_D 16.0  STEIGUNG 2.0))
	    	 ((string= M_REGEL "M20")       (setf GEW_D 20.0  STEIGUNG 2.5))
	    	 ((string= M_REGEL "M24")       (setf GEW_D 24.0  STEIGUNG 3.0))
	    	 ((string= M_REGEL "M30")       (setf GEW_D 30.0  STEIGUNG 3.5))
	    	 ((string= M_REGEL "M36")       (setf GEW_D 36.0  STEIGUNG 4.0))
	    	 ((string= M_REGEL "M42")       (setf GEW_D 42.0  STEIGUNG 4.5))
	    	 ((string= M_REGEL "M48")       (setf GEW_D 48.0  STEIGUNG 5.0))
	    	 ((string= M_REGEL "M56")       (setf GEW_D 56.0  STEIGUNG 5.5))
	    	 ((string= M_REGEL "M64")       (setf GEW_D 64.0  STEIGUNG 6.0))
	    	);;cond
	    );;1
	    ;; 2=metrisches Feingewinde
	    (2  (cond
	    	 ((string= M_FEIN "M2x0,25")	(setf GEW_D 2.0   STEIGUNG 0.25))
	    	 ((string= M_FEIN "M3x0,25")	(setf GEW_D 3.0   STEIGUNG 0.25))
	    	 ((string= M_FEIN "M4x0,2")	(setf GEW_D 4.0   STEIGUNG 0.2))
	    	 ((string= M_FEIN "M4x0,35")	(setf GEW_D 4.0   STEIGUNG 0.35))
	    	 ((string= M_FEIN "M5x0,25")	(setf GEW_D 5.0   STEIGUNG 0.25))
	    	 ((string= M_FEIN "M5x0,5")	(setf GEW_D 5.0   STEIGUNG 0.5))
	    	 ((string= M_FEIN "M6x0,25")	(setf GEW_D 6.0   STEIGUNG 0.25))
	    	 ((string= M_FEIN "MM6x0,5")	(setf GEW_D 6.0   STEIGUNG 0.5))
	    	 ((string= M_FEIN "M6x0,75")	(setf GEW_D 6.0   STEIGUNG 0.75))
	    	 ((string= M_FEIN "M8x0,25")	(setf GEW_D 8.0   STEIGUNG 0.25))
	    	 ((string= M_FEIN "M8x0,5")	(setf GEW_D 8.0   STEIGUNG 0.5))
	    	 ((string= M_FEIN "M8x1")	(setf GEW_D 8.0   STEIGUNG 1.0))
	    	 ((string= M_FEIN "M10x0,25")	(setf GEW_D 10.0  STEIGUNG 0.25))
	    	 ((string= M_FEIN "M10x0,5")	(setf GEW_D 10.0  STEIGUNG 0.5))
	    	 ((string= M_FEIN "M10x1")	(setf GEW_D 10.0  STEIGUNG 1.0))
	    	 ((string= M_FEIN "M12x0,35")	(setf GEW_D 12.0  STEIGUNG 0.35))
	    	 ((string= M_FEIN "M12x0,5")	(setf GEW_D 12.0  STEIGUNG 0.5))
	    	 ((string= M_FEIN "M12x1")	(setf GEW_D 12.0  STEIGUNG 1.0))
	    	 ((string= M_FEIN "M16x0,5")	(setf GEW_D 16.0  STEIGUNG 0.5))
	    	 ((string= M_FEIN "M16x1")	(setf GEW_D 16.0  STEIGUNG 1.0))
	    	 ((string= M_FEIN "M16x1,5")	(setf GEW_D 16.0  STEIGUNG 1.5))
	    	 ((string= M_FEIN "M20x1")	(setf GEW_D 20.0  STEIGUNG 1.0))
	    	 ((string= M_FEIN "M20x1,5")	(setf GEW_D 20.0  STEIGUNG 1.5))
	    	 ((string= M_FEIN "M24x1,5")	(setf GEW_D 24.0  STEIGUNG 1.5))
	    	 ((string= M_FEIN "M24x2")	(setf GEW_D 24.0  STEIGUNG 2.0))
	    	 ((string= M_FEIN "M30x1,5")	(setf GEW_D 30.0  STEIGUNG 1.5))
	    	 ((string= M_FEIN "M30x2")	(setf GEW_D 30.0  STEIGUNG 2.0))
	    	 ((string= M_FEIN "M36x1,5")	(setf GEW_D 36.0  STEIGUNG 1.5))
	    	 ((string= M_FEIN "M36x2")	(setf GEW_D 36.0  STEIGUNG 2.0))
	    	 ((string= M_FEIN "M42x1,5")	(setf GEW_D 42.0  STEIGUNG 1.5))
	    	 ((string= M_FEIN "M42x2")	(setf GEW_D 42.0  STEIGUNG 2.0))
	    	 ((string= M_FEIN "M48x1,5")	(setf GEW_D 48.0  STEIGUNG 1.5))
	    	 ((string= M_FEIN "M48x2")	(setf GEW_D 48.0  STEIGUNG 2.0))
	    	 ((string= M_FEIN "M56x1,5")	(setf GEW_D 56.0  STEIGUNG 1.5))
	    	 ((string= M_FEIN "M56x2")	(setf GEW_D 56.0  STEIGUNG 2.0))
	    	 ((string= M_FEIN "M64x2")	(setf GEW_D 64.0  STEIGUNG 2.0))
	    	);;cond
	    );;2
	);;case GEWINDE_ART

        ;;Profil erstellen
        (geometry_mode :real)
        (let (FA P1 P2 P3 P4)
          (setf FA (/ (- GEW_D (* 0.85 GEW_D)) 2))
          (setf P1 (make-gpnt2d :x GEW_L :y 0))
          (setf P2 (make-gpnt2d :x GEW_L :y (- (/ GEW_D 2) FA)))
          (setf P3 (make-gpnt2d :x (- GEW_L FA) :y (/ GEW_D 2)))
          (setf P4 (make-gpnt2d :x 0 :y (/ GEW_D 2)))
          (polygon 0,0 P1 P2 P3 P4 0,0)
        );;let

        ;;Tempor�res Teil erstellen
        (create_part :name "temp_part" :owner "/")
        
        ;;Drehen
        (sd-call-cmds
         (turn :sel_part (sd-inq-curr-part) :wp (sd-inq-curr-wp) :axis :u :rotation_angle (* 2 pi) :keep_wp :yes :keep_profile :no)
	);;sd-call-cmds

	;;Zylinderflaeche bestimmen
	(setf FLAECHE (first (sd-call-cmds (get_selection :focus_type *sd-cylinder-seltype* :select :in_part (sd-inq-curr-part))))
	      ALLES (sd-inq-geo-props FLAECHE :dest-space :global)
	      RADIUS (sd-cylinder-radius ALLES)
	      RICHTUNG (sd-cylinder-axis-dir ALLES))

 	(sd-define-thread FLAECHE
 	    :nominal-diameter GEW_D
 	    :core-diameter (* 0.85 GEW_D)
 	    :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 (= GEWINDE_ART 1):M :MF)
 	    :include-chamfer T
 	    :thread-direction RICHTUNG
 	    :thread-name (case GEWINDE_ART
			      ;;metrisches Regelgewinde
			      (1
			        (if RECHTS_GEW
				   (format nil "~a" M_REGEL)
				   (format nil "~a-LH" M_REGEL)
			        );;if
			      );;1
			     ;;metrisches Feingewinde
			     (2
			       (if RECHTS_GEW
				   (format nil "~a" M_FEIN)
				   (format nil "~a-LH" M_FEIN)
			       );;if
			     );;2
			);;case 	    
 	);;sd-define-thread

	;;Beschriften
	(Cocreate_3d_note :action :create :items FLAECHE
			  :note (case GEWINDE_ART
				  ;;metrisches Regelgewinde
			          (1
			  	     (if RECHTS_GEW
				        (format nil "~a" M_REGEL)
				        (format nil "~a-LH" M_REGEL)
				     );;if
				  );;1
				  ;;metrisches Feingewinde
				  (2
			  	     (if RECHTS_GEW
				        (format nil "~a" M_FEIN)
				        (format nil "~a-LH" M_FEIN)
				     );;if
				  );;2
				);;case
	);;Beschriften	
	
	;; Gewindefreistich
	(if (not FREIST_N)
	 (progn
	  ;;Werte f�r metrischen Gewindefreistich zuordnen
	  (let (R DG_W G1_A G1_B DG2 TAN_60 A B P1 P2 P3 P4 P5)
 	   (case STEIGUNG
	     (0.2	(setf  R 0.1  DG_W 0.3  G1_A 0.5  G1_B 0.3))
	     (0.25	(setf  R 0.1  DG_W 0.4  G1_A 0.6  G1_B 0.3));;M1
	     (0.3	(setf  R 0.2  DG_W 0.5  G1_A 0.6  G1_B 0.3))
	     (0.35	(setf  R 0.2  DG_W 0.6  G1_A 0.7  G1_B 0.4));;M1,6
	     (0.4	(setf  R 0.2  DG_W 0.7  G1_A 0.8  G1_B 0.5));;M2
	     (0.45	(setf  R 0.2  DG_W 0.7  G1_A 1.0  G1_B 0.5));;M2,5
	     (0.5	(setf  R 0.2  DG_W 0.8  G1_A 1.1  G1_B 0.5));;M3
	     (0.6	(setf  R 0.4  DG_W 1.0  G1_A 1.2  G1_B 0.6))
	     (0.7	(setf  R 0.4  DG_W 1.1  G1_A 1.5  G1_B 0.8));;M4
	     (0.75	(setf  R 0.4  DG_W 1.2  G1_A 1.6  G1_B 0.9))
	     (0.8	(setf  R 0.4  DG_W 1.3  G1_A 1.7  G1_B 0.9));;M5
	     (1.0	(setf  R 0.6  DG_W 1.6  G1_A 2.1  G1_B 1.1));;M6
	     (1.25	(setf  R 0.6  DG_W 2.0  G1_A 2.7  G1_B 1.5));;M8
	     (1.5	(setf  R 0.8  DG_W 2.3  G1_A 3.2  G1_B 1.8));;M10
	     (1.75	(setf  R 1.0  DG_W 2.6  G1_A 3.9  G1_B 2.1));;M12
	     (2.0	(setf  R 1.0  DG_W 3.0  G1_A 4.5  G1_B 2.5));;M16
	     (2.5	(setf  R 1.2  DG_W 3.6  G1_A 5.6  G1_B 3.2));;M20
	     (3.0	(setf  R 1.6  DG_W 4.4  G1_A 6.7  G1_B 3.7));;M24
	     (3.5	(setf  R 1.6  DG_W 5.0  G1_A 7.7  G1_B 4.7));;M30
	     (4.0	(setf  R 2.0  DG_W 5.7  G1_A 9.0  G1_B 5.0));;M36
	     (4.5	(setf  R 2.0  DG_W 6.4  G1_A 11.0 G1_B 5.5));;M42
	     (5.0	(setf  R 2.5  DG_W 7.0  G1_A 12.0 G1_B 6.5));;M48
	     (5.5	(setf  R 3.2  DG_W 7.7  G1_A 13.0 G1_B 7.5));;M56
	     (6.0	(setf  R 3.2  DG_W 8.3  G1_A 14.0 G1_B 8.0));;M64
 	   );;case
	   (setf DG2 (/ (- GEW_D DG_W) 2))
	   (setf TAN_60 (tan (sd-deg-to-rad 60)))
	   (setf A (/ (- RADIUS DG2) 2))
	   (setf B (* TAN_60 A))
	   (if FORM_A
	      (setf G1 G1_A)
	      (setf G1 G1_B)
	   );;if
	   (setf P1 (make-gpnt2d :x 0 :y DG2)
		 P2 (make-gpnt2d :x G1 :y DG2)
		 P3 (make-gpnt2d :x (+ G1 B) :y RADIUS)
		 P4 (make-gpnt2d :x (+ G1 B) :y (+ RADIUS 1))
		 P5 (make-gpnt2d :x 0 :y (+ RADIUS 1))
	   );;setf
	   ;;Profil fuer Gewindefreistich erstellen
	   (geometry_mode :real)
	   (polygon P1 P2 P3 P4 P5 :close)
	   (fillet :create :fillet_radius R P1 P2)
	  );;let
	  ;;Gewindefreistich erstellen
	  (sd-call-cmds (bore :parts (sd-inq-curr-part) :keep_wp :no :axis :u :rotation_angle (* 2 pi)))
	 );;progn
	 (delete_3d (sd-inq-curr-wp))
	);;if (not FREIST_N)  === Ende Gewindefreistich ===

	;;Mit TEIL verschmelzen
       	(sd-call-cmds (unite_3d :blank TEIL :tools (sd-inq-curr-part) :keep_tools :no))

	;;Urspungs AE aktiv setzen
	(current_wp AKT_WP)

	;;Ursprungsteil aktiv setzen
	(current_part TEIL)
	
	;;Feedback loeschen
	(sd-end-feedback ACHSEN-FEEDBACK)
       );;progn
      );;sd-call-cmds
    );;Gewindebolzen-erstellen

    ;; 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

    (Achsenrichtung-wechseln ()
	(sd-end-feedback ACHSEN-FEEDBACK)
	(setf K_ACHSEN-R (make-gpnt3d	:x (* -1 (gpnt3d_x K_ACHSEN-R))
					:y (* -1 (gpnt3d_y K_ACHSEN-R))
					:z (* -1 (gpnt3d_z K_ACHSEN-R))))
	(setf ACHSEN-FEEDBACK (sd-start-direction-feedback :point K_MITTELPUNKT :direction K_ACHSEN-R :disc t :color 0,0,1))
    );;Achsenrichtung-wechseln

    (Kantenproperties ()
	(setf
	  K_ALLES	(sd-inq-geo-props KANTE :dest-space :global)
	  K_MITTELPUNKT	(sd-circle-center K_ALLES)
	  K_RADIUS	(sd-circle-radius K_ALLES)
	  K_V-RICHTUNG	(sd-circle-start-dir K_ALLES)
	  K_ACHSEN-R	(sd-circle-normal  K_ALLES)
	  K_DURCHMESSER	(* K_RADIUS 2)
	);setf
       (setf ACHSEN-FEEDBACK (sd-start-direction-feedback :point K_MITTELPUNKT :direction K_ACHSEN-R :disc t :color 0,0,1))
    );;Kantenproperties

  );;local-function

  :cancel-action '(sd-end-feedback ACHSEN-FEEDBACK)

  :ok-action
  '(Gewindebolzen-erstellen)

);;sd-defdialog

;;=== EOF =========================================================================================================================