;;====================================================================================================== ;; os_gew_a_freistich.lsp V1.0 ;; os / 08.03.2004 (in-package :GD-package) (use-package :oli) (sd-defdialog 'os-gew-a-freistich :dialog-title "Gewindefreistich" :toolbox-button t :variables '( (ALLES) ;Alles von gewählter Kante (MITTELPUNKT) ;Mittelpunkt der Kante (RADIUS) ;Radius Kante (ACHSEN-R) ;Normale Kreiskante (V-RICHTUNG) ;Vektor vom Mittelpunkt zum Umfang (ACHSEN-FEEDBACK) (AKT_WP) ("fuer Metr. Aussengewinde") (FORM_A :value-type :boolean :initial-value t :toggle-type :grouped-toggle :title "Form A") (FORM_B :value-type :boolean :toggle-type :grouped-toggle :title "Form B") (TEIL :value-type :part :title "Teil" :prompt-text "Teil anklicken") (KANTE :value-type :edge :title "Kante" :prompt-text "Kante anklicken" :check-function Eingabe_pruefen :after-input (Kantenproperties)) (UMKEHREN :title "Umkehren" :toggle-type :wide-toggle :push-action (Achsenrichtung-wechseln)) ("Nenndurchmesser") (DURCHMESSER :title "M" :value-type :display-only :initial-value 0 :display-units :length) );variables :mutual-exclusion '(FORM_A FORM_B) :ok-action '(Freistich-abdrehen) :cancel-action '(sd-end-feedback ACHSEN-FEEDBACK) :local-functions '( (Freistich-abdrehen () (sd-call-cmds (progn (setf AKT_WP (sd-inq-curr-wp)) ;Arbeitsebene erstellen (create_workplane :new :name "tmp-Ae" :pt_dir :origin MITTELPUNKT :normal V-RICHTUNG :u_dir ACHSEN-R) (let (R DG_W G1_A G1_B DG2 TAN_60 A B P1 P2 P3 P4 P5) ;;Werte zuordnen (case DURCHMESSER (1.0 (setf R 0.1 DG_W 0.4 G1_A 0.6 G1_B 0.3));;M1 (1.6 (setf R 0.2 DG_W 0.6 G1_A 0.7 G1_B 0.4));;M1,6 (2.0 (setf R 0.2 DG_W 0.7 G1_A 0.8 G1_B 0.5));;M2 (2.5 (setf R 0.2 DG_W 0.7 G1_A 1.8 G1_B 0.5));;M2,5 (3.0 (setf R 0.2 DG_W 0.8 G1_A 1.1 G1_B 0.5));;M3 (4.0 (setf R 0.4 DG_W 1.1 G1_A 1.5 G1_B 0.8));;M4 (5.0 (setf R 0.4 DG_W 1.3 G1_A 1.7 G1_B 0.9));;M5 (6.0 (setf R 0.6 DG_W 1.6 G1_A 2.1 G1_B 1.1));;M6 (8.0 (setf R 0.6 DG_W 2.0 G1_A 2.7 G1_B 1.5));;M8 (10.0 (setf R 0.8 DG_W 2.3 G1_A 3.2 G1_B 1.8));;M10 (12.0 (setf R 1.0 DG_W 2.6 G1_A 3.9 G1_B 2.1));;M12 (16.0 (setf R 1.0 DG_W 3.0 G1_A 4.5 G1_B 2.5));;M16 (20.0 (setf R 1.2 DG_W 3.6 G1_A 5.6 G1_B 3.2));;M20 (24.0 (setf R 1.6 DG_W 4.4 G1_A 6.7 G1_B 3.7));;M24 (30.0 (setf R 1.6 DG_W 5.0 G1_A 7.7 G1_B 4.7));;M30 (36.0 (setf R 2.0 DG_W 5.7 G1_A 9.0 G1_B 5.0));;M36 (42.0 (setf R 2.0 DG_W 6.4 G1_A 11.0 G1_B 5.5));;M42 (48.0 (setf R 2.5 DG_W 7.0 G1_A 12.0 G1_B 6.5));;M48 (56.0 (setf R 3.2 DG_W 7.7 G1_A 13.0 G1_B 7.5));;M56 (64.0 (setf R 3.2 DG_W 8.3 G1_A 14.0 G1_B 8.0));;M64 (otherwise (display (format nil "~a ist kein Metrisches Gewinde" Durchmesser))) );;case (setf DG2 (/ (- DURCHMESSER DG_W) 2)) (setf TAN_60 (tan (*(/(* 2 pi) 360.0) 60.0))) (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 erstellen (geometry_mode :real) (polygon P1 P2 P3 P4 P5 :close) (fillet :create :fillet_radius R P1 P2) );;let ;;Abdrehen (bore :parts TEIL :keep_wp :no :axis :u :rotation_angle (* 2 pi)) (if AKT_WP (current_wp AKT_WP)); nil) );;progn );;sd-call-cmds (sd-end-feedback ACHSEN-FEEDBACK) );Freistich-abdrehen ende (Kantenproperties () (setf ALLES (sd-inq-geo-props KANTE :dest-space :global) MITTELPUNKT (sd-circle-center ALLES) RADIUS (sd-circle-radius ALLES) V-RICHTUNG (sd-circle-start-dir ALLES) ACHSEN-R (sd-circle-normal ALLES) DURCHMESSER (* RADIUS 2) );setf (setf ACHSEN-FEEDBACK (sd-start-direction-feedback :point MITTELPUNKT :direction ACHSEN-R :disc t :color 0,0,1)) );;Kantenproperties (Achsenrichtung-wechseln () (sd-end-feedback ACHSEN-FEEDBACK) (setf ACHSEN-R (make-gpnt3d :x (* -1 (gpnt3d_x ACHSEN-R)) :y (* -1 (gpnt3d_y ACHSEN-R)) :z (* -1 (gpnt3d_z ACHSEN-R)))) (setf ACHSEN-FEEDBACK (sd-start-direction-feedback :point MITTELPUNKT :direction ACHSEN-R :disc t :color 0,0,1)) );;Achsenrichtung-wechseln ;; Eingabe auf Geo (Kreis) und gueltige Durchmesser pruefen (Eingabe_pruefen (I) (if (sd-circle-p (sd-inq-geo-props I :dest-space :global)) (progn (setf RADIUS (sd-circle-radius (sd-inq-geo-props I :dest-space :global))) (setf DURCHMESSER (* RADIUS 2)) (case DURCHMESSER ((1.0 1.6 2.0 2.5 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 Gewinde" Durchmesser))) );;case );;progn (values :error "Das war keine Kreiskante!") );;if );Eingabe_pruefen );;local-functions );;sd-defdialog