;;**************************************************************************

;;**************************************************************************
(in-package :lpo_vdaps)  ;;; All variables and functions have to belong to 
                         ;;; the package 'lpo_vdaps' 
;;**************************************************************************
;;* 
;;* This function defines the type and the subtype of the created geometry.
;;* The behaviour of the user interface depends on the type and subtype.
;;* 
;;* Following types and subtypes are supported:
;;* 
;;* Type             Subtype      Description
;;* --------------------------------------------------------
;;* VDAPS_PART       REAL         Body  
;;* VDAPS_HOLE       REAL         Machined features (Material removed)
;;* VDAPS_FORM_ADD   REAL         Machined features (Material added)
;;*
;;**************************************************************************
(defun GD00030_control ( mode ) 
  (when (oli::sd-string= "INIT" mode) 
    (lpo_vdaps::api_set_geometry_type "VDAPS_PART" "REAL")
  );;when
);;defun

;;**************************************************************************
;;*
;;* Completepart            : GD00030
;;* Geometry                : Ettinger Abstandsbolzen Außen - Außen
;;* Parameter               : (gepa_list) =
;;*                           Created with GD-00030.TAB line
;;* 
;;* GE,PA,GD00030,G1,G2,SW,L1,A1,A2,MA,F1
;;* C
;;* ZA,MM,9
;;* MM,SM, 1, 10, 1, 1, G1  , 'Gewinde G1'            , 'g1',     , T
;;* MM,SM, 1, 20, 1, 1, G2  , 'Gewinde G2'            , 'g2',     , T
;;* MM,SM, 1, 30, 1, 1, SW  , 'Schlüsselweite SW'     , 'sw', 'mm', Z
;;* MM,SM, 1, 40, 1, 1, L1  , 'Länge L'               , 'l1', 'mm', Z  
;;* MM,SM, 1, 50, 1, 1, A1  , 'Länge Gewinde 1 A1'    , 'a1', 'mm', Z
;;* MM,SM, 1, 60, 1, 1, A2  , 'Länge Gewinde 2 A2'    , 'a2', 'mm', Z
;;* MM,SM, 1, 70, 1, 1, MA  , 'Material'              , 'ma',     , T
;;* MM,SM, 1, 80, 1, 1, BN  , 'Bestellnummer'         , 'bn',     , T
;;* MM,SM, 1, 90, 1, 1, F1  , 'Freistich'             , 'f1',     , T
;;*
;;**************************************************************************
(defun GD00030 ( gepa_list )
 (progn (sd-call-cmds
  ;; Setze Variablen von 'GE,PA' Liste fuer Komplettteil
  ;;---------------------------------------------------------
  (let ((G1) (G2) (SW) (L1) (A1) (A2) (MA) (F1) (Partname) (Akt_wp))
    ;;-------------------------------------------------------
    ;; Lokale GEO Variablen aus ge_pa Liste zuweisen
    ;;-------------------------------------------------------
    (setf G1 (nth 0 gepa_list)) 
    (setf G2 (nth 1 gepa_list)) 
    (setf SW (nth 2 gepa_list))
    (setf L1 (nth 3 gepa_list))
    (setf A1 (nth 4 gepa_list))
    (setf A2 (nth 5 gepa_list))
    (setf MA (nth 6 gepa_list))
    (setf F1 (nth 7 gepa_list))
    ;;-------------------------------------------------------
    ;;  Partnamen von der SolidLibrary abfragen
    ;;-------------------------------------------------------
    (setf Partname (lpo_vdaps::sl_get_envar :PARTNAME))
    ;;-------------------------------------------------------
    ;; Neue Arbeitsebene erzeugen
    ;;-------------------------------------------------------
    (setf Akt_wp (sd-inq-curr-wp))
    (sd-call-cmds (create_workplane :new :world_origin))
    (sd-call-cmds (delete_2d :current_wp :edge_2d :all_2d) :failure nil)
    ;;-------------------------------------------------------
    ;;Gewindeparameter definieren und Gewinde G1 erstellen
    (let ((G) (GEW_D) (KERN_D_B) (KERN_D_M) (STEIGUNG) (GEW_PROF) (A0) (F_TYP))
      ;;GEW_D=Gewindenenndurchmesser KERN_D_B=Kerndurchmesser Bolzen KERN_D_M=Kerndurchmesser Mutter
      ;;STEIGUNG=Gewindesteigung GEW_PROF=Gewindeprofil A0=Gewindelänge F_TYP=Freistich-Typ
      (cond
       ((string= G1 "M2,5") (setf G "M2,5"  GEW_D 2.5   KERN_D_B 1.95 KERN_D_M 2.01 STEIGUNG 0.45 GEW_PROF :M   A0 A1   F_TYP "B"))
       ((string= G1 "M3")   (setf G "M3"    GEW_D 3.0   KERN_D_B 2.39 KERN_D_M 2.46 STEIGUNG 0.5  GEW_PROF :M   A0 A1   F_TYP "B"))
       ((string= G1 "M4")   (setf G "M4"    GEW_D 4.0   KERN_D_B 3.14 KERN_D_M 3.24 STEIGUNG 0.7  GEW_PROF :M   A0 A1   F_TYP "B"))
       ((string= G1 "M5")   (setf G "M5"    GEW_D 5.0   KERN_D_B 4.02 KERN_D_M 4.13 STEIGUNG 0.8  GEW_PROF :M   A0 A1   F_TYP "A"))
       ((string= G1 "M6")   (setf G "M6"    GEW_D 6.0   KERN_D_B 4.77 KERN_D_M 4.92 STEIGUNG 1.0  GEW_PROF :M   A0 A1   F_TYP "A"))
       ((string= G1 "M8")   (setf G "M8"    GEW_D 8.0   KERN_D_B 6.47 KERN_D_M 6.65 STEIGUNG 1.25 GEW_PROF :M   A0 A1   F_TYP "A"))
      );;cond
      ;;-------------------------------------------------------
      ;;Gewinde G2 erstellen
      (GD00030-gewinde-aussen-erstellen G GEW_D KERN_D_B STEIGUNG GEW_PROF A0)
      ;;-------------------------------------------------------
      ;; Gewindefreistich
      (if (string= F1 "ja")
        (GD00030-freistich-erstellen STEIGUNG GEW_D F_TYP)
      );;if
    );;let
    ;;-------------------------------------------------------
    ;;Sechskant erstellen
    (GD00030-sechskant-erstellen SW L1)
    ;;-------------------------------------------------------
    ;;Arbeitsebene um 180 Grad drehen und um Länge L1 verschieben
    (sd-call-cmds (position_wp :workplane (sd-inq-curr-wp) :rotate :axis :y :rotation_angle pi))
    (sd-call-cmds (position_wp :workplane (sd-inq-curr-wp) :translate :dir_len :neg_x :len L1))
    ;;-------------------------------------------------------
    ;;Gewindeparameter definieren und Gewinde G2 erstellen
    (let ((G) (GEW_D) (KERN_D_B) (KERN_D_M) (STEIGUNG) (GEW_PROF) (A0) (F_TYP))
      ;;GEW_D=Gewindenenndurchmesser KERN_D_B=Kerndurchmesser Bolzen KERN_D_M=Kerndurchmesser Mutter
      ;;STEIGUNG=Gewindesteigung GEW_PROF=Gewindeprofil A0=Gewindelänge F_TYP=Freistich-Typ
      (cond
       ((string= G2 "M2,5") (setf G "M2,5"  GEW_D 2.5   KERN_D_B 1.95 KERN_D_M 2.01 STEIGUNG 0.45 GEW_PROF :M   A0 A2   F_TYP "B"))
       ((string= G2 "M3")   (setf G "M3"    GEW_D 3.0   KERN_D_B 2.39 KERN_D_M 2.46 STEIGUNG 0.5  GEW_PROF :M   A0 A2   F_TYP "B"))
       ((string= G2 "M4")   (setf G "M4"    GEW_D 4.0   KERN_D_B 3.14 KERN_D_M 3.24 STEIGUNG 0.7  GEW_PROF :M   A0 A2   F_TYP "B"))
       ((string= G2 "M5")   (setf G "M5"    GEW_D 5.0   KERN_D_B 4.02 KERN_D_M 4.13 STEIGUNG 0.8  GEW_PROF :M   A0 A2   F_TYP "A"))
       ((string= G2 "M6")   (setf G "M6"    GEW_D 6.0   KERN_D_B 4.77 KERN_D_M 4.92 STEIGUNG 1.0  GEW_PROF :M   A0 A2   F_TYP "A"))
       ((string= G2 "M8")   (setf G "M8"    GEW_D 8.0   KERN_D_B 6.47 KERN_D_M 6.65 STEIGUNG 1.25 GEW_PROF :M   A0 A2   F_TYP "A"))
      );;cond
      ;;-------------------------------------------------------      
      ;;Temporäres Teil erstellen
      (sd-call-cmds (create_part :name "GD00030_temp" :owner "/"))
      ;;-------------------------------------------------------
      ;;Gewinde G2 erstellen                  
      (GD00030-gewinde-aussen-erstellen G GEW_D KERN_D_B STEIGUNG GEW_PROF A0)
      ;;-------------------------------------------------------
      ;; Gewindefreistich
      (if (string= F1 "ja")
        (GD00030-freistich-erstellen STEIGUNG GEW_D F_TYP)
      );;if
      ;;-------------------------------------------------------      
      ;;Temporäres Teil mit Library verschmelzen und dieses aktiv setzen
      (sd-call-cmds (unite_3d :blank PARTNAME :tools (sd-inq-curr-part) :keep_tools :no))
      (sd-call-cmds (current_part PARTNAME))
    );;let
    ;;-------------------------------------------------------
    ;;Arbeitsebene zurückschieben und drehen
    ;(sd-call-cmds (position_wp :workplane (sd-inq-curr-wp) :translate :dir_len :x :len L1))
    ;(sd-call-cmds (position_wp :workplane (sd-inq-curr-wp) :rotate :axis :y :rotation_angle pi))
    (sd-call-cmds (delete_3d :workplane :current))
    ;;-------------------------------------------------------
    (let ((DICHTE) (FARBE))
      (cond
        ((string= MA "St verzinkt")   (setf DICHTE 0.00785  FARBE 0.6,0.6,0.6))
        ((string= MA "St gelbchrom.") (setf DICHTE 0.00785  FARBE 0.6,0.6,0.6))
        ((string= MA "Ms vernickelt") (setf DICHTE 0.0085   FARBE 1,0.8,0))
        ((string= MA "St rostfrei")   (setf DICHTE 0.00785  FARBE 0.6,0.6,0.6))
      );;cond
      (sd-call-cmds (set_part_inst_density :parts (sd-inq-curr-part) :dens DICHTE))
      (sd-call-cmds (set_part_inst_color :parts (sd-inq-curr-part) :color (sd-rgb-to-color FARBE)))
    );;let
  (sd-call-cmds (current_wp Akt_wp) :failure nil)
  );;let
 ));;sd-call-cmds progn
);;defun GD00030

(defun GD00030-gewinde-aussen-erstellen (G GEW_D KERN_D_B STEIGUNG GEW_PROF A0)
  (let (FA P1 P2 P3 P4 FLAECHE ALLES RADIUS RICHTUNG)
        ;;Profil erstellen
        (geometry_mode :real)
        (setf FA (/ (- GEW_D (* 0.85 GEW_D)) 2))
        (setf P1 (make-gpnt2d :x A0 :y 0))
        (setf P2 (make-gpnt2d :x A0 :y (- (/ GEW_D 2) FA)))
        (setf P3 (make-gpnt2d :x (- A0 FA) :y (/ GEW_D 2)))
        (setf P4 (make-gpnt2d :x 0 :y (/ GEW_D 2)))
        (sd-call-cmds (polygon 0,0 P1 P2 P3 P4 0,0))
        ;;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))
        ;;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)
        );;setf
        ;;Gewinde definieren
        (sd-call-cmds
          (sd-define-thread FLAECHE
            :nominal-diameter GEW_D
            :core-diameter KERN_D_B
            :pitch STEIGUNG
            :thread-type :OUTER
            :thread-unit :METRIC
            :thread-color (sd-color-to-rgb 16753049)
            :thread-hand :RIGHT-HAND
            :thread-profile GEW_PROF
            :include-chamfer T
            :thread-direction RICHTUNG
            :thread-name G
          );;sd-define-thread
        );;sd-call-cmds
  );;let
);;defun

(defun GD00030-sechskant-erstellen (SW L1)
  ;;Arbeitsebene um 90 Grad drehen
  (sd-call-cmds (position_wp :workplane (sd-inq-curr-wp) :rotate :axis :y :rotation_angle (/ pi 2)))
  ;;Profil für Vieleck erstellen
  (sd-call-cmds (geometry_mode :real))
  (let (RAD_ID ALFAP ALFAS ALFAB ALFAC Counter X0 X1 XP Y0 Y1 YP)
    (setq RAD_ID (/ SW 2))
    (setq ALFAP (/ (- 180 (/ 360 6)) 2))
    (setq ALFAS (/ 360 6))
    (setq ALFAB (+ ALFAP (/ (* 0 360) (* pi 2))))
    (setq RAD_ID (/ RAD_ID (sin (sd-deg-to-rad ALFAP))))  
    (dotimes (Counter 6)
      (setq ALFAC (+ ALFAB (* ALFAS Counter)))
      (setq X1 (* RAD_ID (cos (sd-deg-to-rad ALFAC) )))
      (setq Y1 (* RAD_ID (sin (sd-deg-to-rad ALFAC) )))
      (cond
        ((> Counter 0) (line :two_points (make-gpnt2d :x X0 :y Y0) (make-gpnt2d :x X1 :y Y1))) 
        ((= Counter 0) (setq XP X1) (setq YP Y1))
      );;cond
      (setq X0 X1)
      (setq Y0 Y1)
    );;dotimes
    (sd-call-cmds (line :two_points (make-gpnt2d :x X0 :y Y0) (make-gpnt2d :x XP :y YP)))
  );;let
  ;;Vieleck extrudieren
  (sd-call-cmds
    (extrude :wp (sd-inq-curr-wp)
          :part (sd-inq-curr-part)
          :direction :-W :distance L1
          :keep_wp :yes :keep_profile :no)
  );;sd-call-cmds
  ;;Arbeitsebene zurückdrehen
  (sd-call-cmds (position_wp :workplane (sd-inq-curr-wp) :rotate :axis :y :rotation_angle (* -1 (/ pi 2))))
);;defun

(defun GD00030-freistich-erstellen (STEIGUNG GEW_D F_TYP)
   ;;Werte für metrischen Gewindefreistich zuordnen
   (let (R DG_W G1 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
     );;case
     (setf DG2 (/ (- GEW_D DG_W) 2))
     (setf TAN_60 (tan (sd-deg-to-rad 60)))
     (setf A (/ (- (/ GEW_D 2) DG2) 2))
     (setf B (* TAN_60 A))
     ;;Auswahl zwischen Freistich Typ A und Typ B
     (if (string= F_TYP "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 (/ GEW_D 2))
            P4 (make-gpnt2d :x (+ G1 B) :y (+ (/ GEW_D 2) 1))
            P5 (make-gpnt2d :x 0 :y (/ GEW_D 2))
     );;setf
     ;;Profil fuer Gewindefreistich erstellen
     (geometry_mode :real)
     (sd-call-cmds (polygon P1 P2 P3 P4 P5 :close))
     (sd-call-cmds (fillet :create :fillet_radius R P1 P2))
   );;let
   ;;Gewindefreistich erstellen
   (sd-call-cmds (bore :parts (sd-inq-curr-part) :keep_wp :yes :keep_profile :no :axis :u :rotation_angle (* 2 pi)))
);;defun