;;Aufruf mit create_custom_feature "cocreate_tapped-hole"

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

(sd-deffeature 'TAPPED-HOLE
 ; Feature Identification attributes
    :library 'CoCreate
    :revision 7.1
    :description "Simple Tapped Hole Feature demonstration"
    :feature-type :geometric
 ; Feature Behavior attributes
    :on-copy :copy
    :on-merge :maintain
    :on-split :copy
    :on-xform :maintain
    :on-invalidate :maintain
    :filing '(:sd-file :mi-file :vrml-file :annotator)
    :warning :none
    :save-variables :all
    :owner-variable 'OWNER
    :constructor 
      '(let ((curr-part  (sd-inq-curr-part)) relax-pnt normal name)
	(block construct
         (setq relax-pnt (sd-proj-pnt-on-face 
                              (first CENTER_PT) 
                              (second CENTER_PT) 
                              :source-space :global))
	 (unless relax-pnt
	   (return-from construct nil))
         (setq normal (sd-inq-face-pnt (first CENTER_PT) 
                                       :u (sd-face-relax-pnt-u relax-pnt)
                                       :v (sd-face-relax-pnt-v relax-pnt)
                                       :normal t
                                       :dest-space :global))
         (setq normal (getf normal :normal))
         (sd-call-cmds (create_workplane :new
                                         :pt_dir :origin
                                         (second CENTER_PT)
                                         :normal
                                         normal))
         (sd-call-cmds(CIRCLE :CEN_RAD 0,0 (/ DIA 2.0)))
         (setq name (format nil "/~A" (sd-gen-obj-basename :part)))
         (sd-call-cmds (extrude :sel_part name
                                :distance DEPTH
                                :reverse
                                :keep_wp :no))
         (sd-call-cmds (subtract_3d
                            :blanks (sd-inq-parent-obj (first CENTER_PT))
                            :tools name
                            :keep_tool :no))


         (sd-call-cmds (current_part curr-part))
	)
       )
    :destructor NIL     ; use the default == destroy feat
    :ok-action NIL      ; nothing to be done
    :verifier NIL      ; default - always true

 ; Feature Appearance attributes
    :category "/Fertigung/Bearbeiten/HK-Anpassung"
    :src-location "goodies/example_features"
    :pixmap "c:/Downloads/Bild_43.bmp"
    :name-str `(format nil "M~Ax~A ~A" DIA DEPTH "Unc")
 ; sd-defdialog attributes
    :start-variable 'CENTER_PT
    :after-initialization '(sd-set-range 'DIA '(10.0 12.0 14.0 20.0))
    :dialog-title "Simple Tapped-Hole" ; Create, Modify, Copy, Delete get added
    :variables
     '((CENTER_PT :value-type :face
                  :incl-position :3d
                  :modifies :contents 
                  :multiple-items nil
                  :title "Center Pt"
		  :after-input (setq OWNER (sd-inq-parent-obj (first CENTER_PT)))
                  :prompt-text "Pick Center Pt.")
       (OWNER     :value-type :part
                  :toggle-type :invisible
		  :modifies :contents
		  :initial-value nil)
       (DIA       :range (10.0 12.0 14.0 20.0)
		  :display-units :length
                  :title "Diameter"
                  :initial-value 20.0
                  :prompt-text "Enter Diameter")
       (SPECIFICATION 
		  :value-type :url
		  :initial-value "http://www.spiralock.com/sl-info.htm"
		  :toggle-type :invisible)
       (DEPTH     :value-type :positive-length
                  :prompt-text "Specify Depth of tapped hole."
		  :check-function check-depth
		  :confirmation (:max-depth-exceeded
				 :dialog :warning
				 :prompt 
	 "Specified Depth Exceed 2 times Dia., tool breakage is more likely"
				 :severity :medium
				 :top-label "Tapped Hole Advisor")
                  :initial-value 10))

   :local-functions 
     '((check-depth(depth)
	 (cond ((> depth (* 2.0 DIA)) :max-depth-exceeded)
	       ((< depth (/ DIA 4.0)) 
		 (values :error 
			"Specified Depth is too shallow for tapping operation"))

	       (t :ok)))
      )
		  
)