(in-package :sheet-advisor)
(use-package :oli)
;=================================================
;
; EXTRUDED FLANGE
;
;=================================================
(defun sha-ext_flange-profile
(
hole_dia
thickness

(radius (* 0.6 thickness))

(tap_thick (* 0.6 thickness))
)
(let (
(tool-wp
(sha-tool-wp))
)

(create_workplane :new

:name tool-wp
)

;********* create Profile **********
(CIRCLE :CEN_RAD
0,0

(+ (/ hole_dia 2) radius tap_thick)
)

;******** create Adjustpoints ******
(C_POINT
0,0
)

(setq result (sha-profile-of-wp tool-wp))

(delete_3d (sha-absolute-name tool-wp))
result
)
)
(defun sha-ext_flange-tool
(
hole_dia
height
stamp_dir
thickness
resolution

(radius (* 0.6 thickness))

(tap_thick (* 0.6 thickness))
)
(let ((result nil)

(tool-part (sha-tool-part))
(tool-wp
(sha-tool-wp))
)
(unless (or

(< hole_dia resolution)

(< height (+ radius resolution))

(< radius resolution)

(< tap_thick resolution)
)

(if (equal stamp_dir :DOWN) ;create a new wp for direction DOWN

(create_workplane :new

:name tool-wp

:pt_dir :origin (gpnt3d 0 0 0)
:normal :x
:u_dir :neg_z
)

(create_workplane :new ;create a new wp for direction UP
:name tool-wp

:pt_dir :origin (gpnt3d 0 0 (- thickness))
:normal :x
:u_dir :z
)
)
(POLYGON

(gpnt2d 0 (+ (/ hole_dia 2) radius))

(gpnt2d 0 (+ (/ hole_dia 2) radius tap_thick))

(gpnt2d thickness (+ (/ hole_dia 2) radius tap_thick))
)
(ARC :CEN_RAD_ANG

(gpnt2d (+ thickness radius) (+ (/ hole_dia 2) radius tap_thick))
radius

(gpnt2d thickness (+ (/ hole_dia 2) radius tap_thick))

(gpnt2d (+ thickness radius) (+ (/ hole_dia 2) tap_thick))
)
(POLYGON

(gpnt2d (+ thickness radius) (+ (/ hole_dia 2) tap_thick))

(gpnt2d (+ thickness height) (+ (/ hole_dia 2) tap_thick))

(gpnt2d (+ thickness height) (/ hole_dia 2))

(gpnt2d radius (/ hole_dia 2))
)

(ARC :CEN_RAD_ANG

(gpnt2d radius (+ (/ hole_dia 2) radius))
radius

(gpnt2d 0 (+ (/ hole_dia 2) radius))

(gpnt2d radius (/ hole_dia 2) )
)
(turn

:part tool-part
:axis :z
)

(setq result (sha-body-of-tool-part tool-part))

(delete_3d (sha-absolute-name tool-wp))

(delete_3d tool-part)
)
result
)
)

(in-package :sheet-advisor)
(use-package :oli)
(defun sha-cup_dimple-profile
(&key
radius
height
thickness
resolution

&allow-other-keys
)
(let (

; local variable definition
(result nil)
;

(tool-wp (sha-tool-wp))

; get name for new workplane
)

(create_workplane :new
:name tool-wp
)

;******** create profile ******
(CIRCLE :CEN_RAD
0,0
radius
)

;******** create adjust points ******
(C_POINT
0,0
(gpnt2d radius 0)

(gpnt2d (* -1 radius) 0)
(gpnt2d 0 radius)

(gpnt2d 0 (* -1 radius))

(gpnt2d radius radius)

(gpnt2d (* -1 radius) radius)

(gpnt2d (* -1 radius) (* -1 radius))

(gpnt2d radius (* -1 radius))
)

;**** extract profile from workplane

(setq result (sha-profile-of-wp tool-wp))

;**** delete workplane and part

(delete_3d (sha-absolute-name tool-wp))

;**** set return value as last entry
result
)
)

(in-package :sheet-advisor)
(use-package :oli)
(defun sha-cup_dimple-tool
(&key
radius
height
thickness
resolution

&allow-other-keys
)
(let (

; local variable definition
(result nil)
;

(tool-part (sha-tool-part)) ; get name for new part

(tool-wp (sha-tool-wp))

; get name for new workplane
)

(create_workplane :new
:name tool-wp
:norm_wp
:origin 0,0,0
:normal :u
)

;******** create profile ******

(LINE :TWO_POINTS (gpnt2d 0 height) (gpnt2d -1 height))

(ARC :SMOOTH (gpnt2d 0 height) (gpnt2d radius 0))

(DELETE_2D (gpnt2d -1 height))

(LINE :TWO_POINTS (gpnt2d 0 height) (gpnt2d 0 (* -1 (- thickness height))))

(MOVE_2D :SELECT (gpnt2d radius 0) :VERTICAL (* -1 thickness) :KEEP :ON)

(LINE :TWO_POINTS (gpnt2d radius 0) (gpnt2d radius (* -1 thickness) ))

;******** create tool part ******

(TURN :PART tool-part :AXIS :V)

;**** extract body of part for function result

(setq result (sha-body-of-tool-part tool-part))

;**** delete workplane and part

(delete_3d (sha-absolute-name tool-wp))

(delete_3d tool-part)

;**** set return value as last entry
result
)
)

(sha-define-shop-table "cup_dmp"

:TABLE-TITLE "Cup Dimple"
:COLUMNS
(:RADIUS
:HEIGHT
:ANG :STAMP_DIR
:MIN_THICK
:MAX_THICK :TOOL_ID
:DESCR
:PREFERENCE :ADVICE)
:COLUMN-NAMES
("Radius"

"Height" "Ang" "Stamp Dir"

"Min Thick" "Max Thick"
"Tool Id"
"Descr" "Pref"
"Advice")
:UNITS
(:mm
:mm
:deg
nil
:mm
:mm
nil
nil
nil
nil)
:CONTENTS
(
(5.00
1.70
90
:DOWN
1.00
1.60
"12899"
"6602" :PREF
"-")
(10.00
2.70
180
:UP
1.25
1.65
"12109"
"6690" :PREF
"-")
)

:KEY (:RADIUS :HEIGHT :ANG :STAMP_DIR)

:DISPLAY (:RADIUS :HEIGHT :ANG :STAMP_DIR :PREFERENCE :ADVICE)

:FLAT-TEXT (:TOOL_ID)
; :HELP "sha_dmp"
; unique, not displayable column entries

:PROF_FNC sha-cup_dimple-profile

:TOOL_FNC sha-cup_dimple-tool
)

(sha-tdb-load "my_punch_func.lsp")
(sha-tdb-load "my_stamp_func.lsp")

(sha-define-shop-table "letter_a"
:TABLE-TITLE "Letter A"
:COLUMNS
(:LENGTH :WIDTH :STAMP_DIR :DESCR :TOOL_ID :MIN_THICK :MAX_THICK
:PROF_WP :TOOL_PART :ADVICE)
:COLUMN-NAMES
("Length" "Width" "Stamp Dir" "Descr" "Tool Id" "Min Thick" "Max Thick"
"Prof WP" "Tool Part" "Advice")
:UNITS (:mm :mm nil nil nil :mm :mm
nil nil nil)
:CONTENTS
(
(25 16 :UP "A #1" "AA11" 1.00 1.50
"/users/Jane/cutout_X.sdw" "/users/Jane/emboss_X.sdp" "-")
)
:KEY (:LENGTH :WIDTH :STAMP_DIR)
:DISPLAY (:LENGTH :WIDTH :STAMP_DIR :ADVICE)
:FLAT-TEXT (:TOOL_ID)
)