#|
Example Design Information Features
Note: This is an example file showing concepts of the Integration Kit.
The code itself is not supported and will never be supported.
|#
(in-package :EXAMPLES)
(use-package :OLI )
(defun remove-paint-feat(feat)
(sd-call-cmds (progn (clear_face_color :by_feature feat)
(remove_feature feat))
:success t)
)
(sd-deffeature 'PAINT
; Feature Identification attributes
:library 'CoCreate
:revision 1.0
:description "Paint Feature demonstration"
:feature-type :non-geometric
; Feature Behavior attributes
:on-copy :copy ;default for non-geometric :maintain
:on-merge :maintain ;default for non-geometric :maintain
:on-split :copy ;default for non-geometric :copy
:on-xform :maintain ;default for non-geometric :maintain
:on-invalidate :maintain ; default
:filing '(:sd-file :mi-file :vrml-file :annotator) ;default is :sd-file
:warning NIL ;default is '(:modify :rename :delete)
:destructor 'remove-paint-feat
:verifier NIL ; default is always valid
; Feature Appearance attributes
:category "/Mfg/Finishing"
:src-location "goodies/example_features"
:pixmap "personality/pixmaps/paint.pm"
:name-str '(format nil "~A_~A" F_TYPE "Paint")
;:label-str '(format nil "~A_~A" F_TYPE "Paint") ;;use same as name
; Feature Control attributes
:select-variable 'F_ITEMS
:start-variable 'F_ITEMS
:save-variables :all-visible ;(:none, :all, :all-visible, list)
; sd-defdialog attributes
:dialog-title "My Paint" ; Create, Modify, Copy, Delete get added
:ok-action '(let (faces)
(setq faces
(sd-call-cmds(get_selection :allow_face_part :select
:by_feature (sd-active-cust-feat))))
(sd-call-cmds(set_face_color faces F_COLOR))
)
:variables
'((F_ITEMS :selection (*sd-face-seltype*)
:multiple-items t
:face-part-allowed t
:title "Selection"
:modifies :contents
:prompt-text
"Select Faces for paint feature")
(F_COLOR :value-type :rgb-color
:title "Color"
:prompt-text "Specify a color")
(F_TYPE :value-type :string
:title "Type"
:prompt-text "Specify the paint type."
:initial-value "Latex"))
)
(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 "/Mfg/Machining"
:src-location "goodies/example_features"
:pixmap "personality/pixmaps/tapped_hole.pm"
: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)))
)
)
;WG_tap.lsp
;This program drills a clearance hole into the current part using the current
; work plane and a table as standard tap sizes. It uses the current wp
;as the normal direction and drill depth and tap depth can be changed after
;tap is selected to suit. It then changes the tapped cylinder face to white
;so that it is easily identified.
;Two things that could be improved on is the next key sometimes doesn't change
;the work plane back and it would be nice to be able to label the face and
;be able to select the face to see what the tap size was.
(defvar *tapped-face-color* 1.0,1.0,1.0)
;;----- Logical Table ---------------------------------------------------------
;; NOTE: :std_tap_clearance is approximately equal to (6 * thread pitch)
(sd-create-logical-table "wg_Threaded_Holes"
:columns '(:tap_units :Tap :drill_rad :tap_rad :cham_rad :std_tap_clearance)
:columnNames '("Tap Units" "Tap Size" "Drill Rad" "Tap Rad" "Chamfer Rad" "Std Tap Clearance")
:types '(:string :string :length :length :length :length)
:units '(nil nil :mm :mm :mm :mm)
:contents '(
("inch" "#4-40" (0.0445 :inch) (0.056 :inch) (0.0675 :inch) (0.15 :inch))
("inch" "#5-40" (0.05075 :inch) (0.0625 :inch) (0.074 :inch) (0.15 :inch))
("inch" "#6-32" (0.05325 :inch) (0.069 :inch) (0.08325 :inch) (0.188 :inch))
("inch" "#8-32" (0.068 :inch) (0.082 :inch) (0.09625 :inch) (0.188 :inch))
("inch" "#10-24" (0.0735 :inch) (0.095 :inch) (0.11425 :inch) (0.25 :inch))
("inch" "#10-32" (0.0795 :inch) (0.095 :inch) (0.10925 :inch) (0.188 :inch))
("inch" "#12-24" (0.0885 :inch) (0.108 :inch) (0.12725 :inch) (0.25 :inch))
("inch" "#12-28" (0.09 :inch) (0.108 :inch) (0.12725 :inch) (0.215 :inch))
("inch" "1/4-20" (0.1005 :inch) (0.125 :inch) (0.148 :inch) (0.300 :inch))
("inch" "1/4-28" (0.1065 :inch) (0.125 :inch) (0.14125 :inch) (0.215 :inch))
("inch" "5/16-18" (0.1285 :inch) (0.15625 :inch) (0.1815 :inch) (0.333 :inch))
("inch" "5/16-24" (0.132 :inch) (0.15625 :inch) (0.17525 :inch) (0.25 :inch))
("inch" "3/8-16" (0.15625 :inch) (0.1875 :inch) (0.216 :inch) (0.375 :inch))
("inch" "3/8-24" (0.166 :inch) (0.1875 :inch) (0.20675 :inch) (0.25 :inch))
("inch" "7/16-14" (0.184 :inch) (0.21875 :inch) (0.2515 :inch) (0.429 :inch))
("inch" "7/16-20" (0.1953 :inch) (0.21875 :inch) (0.2415 :inch) (0.300 :inch))
("inch" "1/2-13" (0.21095 :inch) (0.25 :inch) (0.2855 :inch) (0.462 :inch))
("inch" "1/2-20" (0.2265 :inch) (0.25 :inch) (0.273 :inch) (0.300 :inch))
("inch" "9/16-12" (0.2422 :inch) (0.28125 :inch) (0.3195 :inch) (0.500 :inch))
("inch" "9/16-18" (0.2578 :inch) (0.28125 :inch) (0.3065 :inch) (0.333 :inch))
("inch" "5/8-11" (0.2656 :inch) (0.3125 :inch) (0.3545 :inch) (0.546 :inch))
("inch" "5/8-18" (0.28905 :inch) (0.3125 :inch) (0.338 :inch) (0.333 :inch))
("inch" "3/4-10" (0.3281 :inch) (0.375 :inch) (0.421 :inch) (0.600 :inch))
("inch" "3/4-16" (0.34375 :inch) (0.375 :inch) (0.4035 :inch) (0.375 :inch))
("inch" "7/8-9" (0.3828 :inch) (0.4375 :inch) (0.4885 :inch) (0.667 :inch))
("inch" "7/8-14" (0.40625 :inch) (0.4375 :inch) (0.4705 :inch) (0.429 :inch))
("inch" "1-8" (0.4375 :inch) (0.5 :inch) (0.5575 :inch) (0.750 :inch))
("inch" "1-12" (0.46095 :inch) (0.5 :inch) (0.5375 :inch) (0.500 :inch))
("metric" "3-.5" 1.25 1.5 1.7 3.0)
("metric" "4-.7" 1.65 2.0 2.315 4.2)
("metric" "5-.8" 2.1 2.5 2.86 4.8)
("metric" "6-1" 2.5 3.0 3.45 5)
("metric" "8-1.25" 3.4 4.0 4.5625 7.5)
("metric" "10-1.5" 4.25 5.0 5.675 9)
("metric" "12-1.75" 5.1 6.0 6.7875 10.5)
("metric" "16-2" 7.0 8.0 8.9 12.0)
)
)
;;----- Display Table ---------------------------------------------------------
(sd-create-display-table "wg_Threaded_Holes"
:tableTitle "WG Threaded Holes"
:logicalTable "wg_Threaded_Holes"
:columns '(:tap_units :Tap)
:filterStatusLine nil
:applyColumns '(:Tap)
:selectionMode :single-row
:applyAction :default-tokens
)
(defun wg-show-tap-table (tap_units &rest args)
(declare (ignore args))
(sd-filter-display-table "wg_Threaded_Holes"
:column :tap_units :test1 :equal :value1 tap_units)
(sd-show-display-table "wg_Threaded_Holes"
:position '("WG_LIBRARY_FEATURE_TAP-OPTIONS-OPT-CONT-TAP-TB"
:lefttop
)
)
)
(defun wg-hide-tap-table ()
(sd-hide-display-table "wg_Threaded_Holes" :ignorePin t))
(defun tap_hole (&key drill-radius drill-depth drill-point parts &aux mlt)
(setq
mlt (/ drill-radius (sin (/ drill-point 2)))
)
(if (eql 0.0 drill-depth)
(POLYGON 0.0,0.0
(gpnt2d 0.0 drill-radius)
(gpnt2d (+ drill-depth
(* mlt (cos (/ drill-point 2))))
0.0)
:close)
(POLYGON 0.0,0.0
(gpnt2d 0.0 drill-radius)
(gpnt2d drill-depth drill-radius)
(gpnt2d (+ drill-depth
(* mlt (cos (/ drill-point 2))))
0.0)
:close))
(BORE :parts parts
:axis :u
:rotation_angle (* 2 pi)
:keep_wp :yes)
(delete_2d :all_2d)
)
(sd-deffeature 'feature_tap
; Feature identification attributes
:library 'WG_library
:revision 7.1
:description "Comples Tapped hole example"
:feature-type :geometric
:name-str "Tapping"
; Feature behavior attributes
:on-split :copy
:on-merge :maintain
:on-xform :maintain
:on-copy :copy
:on-invalidate :maintain
:attachment :contents
:filing '(:sd-file :mi-file :vrml-file)
:warning '(:invalidate :conflict)
:constructor '(make_drillhole)
:owner-variable 'A_PART
:save-variables :all
:start-variable 'SEL_FACE
; Feature appearance attributes
:category '("/Documentation" "/Mfg/Machining")
:src-location "goodies/example_features"
; :pixmap NIL
:label-str '(format nil
"TAPPED HOLE~%Drill ~a Dia Hole to depth ~a~% ~a to depth ~a"
(sd-num-to-string (sd-sys-to-user-units :length (* 2 drill_rad)) 3)
(sd-num-to-string (sd-sys-to-user-units :length drill-depth) 3)
tap
(sd-num-to-string (sd-sys-to-user-units :length tap-depth) 3))
; SD-DEFDIALOG attributes
:dialog-title "Tap Hole"
:variables
'(
(do_next_action :initial-value t)
(tap_rad :initial-value 0.0)
(drill_rad :initial-value 0.0)
(cham_rad :initial-value nil)
(curr_wp :initial-value (sd-inq-curr-wp))
(temp :initial-value nil)
(A_PART :value-type :part
:toggle-type :invisible
:modifies :contents
:intial-value nil)
(SEL_FACE :value-type :face
:incl-position :3d
:title "CenterPt"
:modifies :contents
:prompt-text "Select the face you to put the tapped hole."
:after-input (setq do_next_action t
A_PART (sd-inq-parent-obj (first SEL_FACE)))
)
(tap_units
:before-input '(setq temp tap_units)
:range ("inch" "metric")
:after-input '(if (not (equal temp tap_units))
(setq Tap nil
Tap-Depth nil
Drill-Depth nil)
)
)
(Tap
:value-type :string
:prompt-text "Specify Tap Type"
:show-input-tool (wg-show-tap-table tap_units)
:hide-input-tool (wg-hide-tap-table)
:after-input
(let (tap_clear Table_values)
(setq do_next_action t
Table_values (sd-read-logical-table-row
"wg_Threaded_Holes"
:pList `(:Tap ,tap)
:units :internal
)
tap_rad (getf Table_values :tap_rad)
drill_rad (getf Table_values :drill_rad)
cham_rad (getf Table_values :cham_rad)
tap_clear (getf Table_values :std_tap_clearance)
tap-depth (* 4 tap_rad)
drill-depth (+ tap-depth tap_clear)
)
)
)
(Tap-Depth
:value-type :length
:prompt-text "Specify Minimum tap depth"
:after-input (progn
(setq do_next_action t)
(if (> Tap-depth Drill-Depth)
(setq Drill-Depth nil)
)
)
)
(Drill-Depth
:value-type :length
:prompt-text "Specify Drill Depth"
:after-input (progn
(setq do_next_action t)
(if (< Drill-Depth Tap-depth)
(setq Tap-Depth nil)
)
)
)
;(Next
; :push-action (make_drillhole)
;)
)
:local-functions
'((make_drillhole ()
(let ((wp-origin (second SEL_FACE))
(owner (sd-inq-parent-obj (first SEL_FACE)))
(relax-pnt (sd-proj-pnt-on-face (first SEL_FACE)
(second SEL_FACE)
:source-space :global))
normal )
(unless relax-pnt
(sd-display-error "There is no material to tap at that location")
(return-from make_drillhole nil)
)
(setq normal (getf (sd-inq-face-pnt (first SEL_FACE)
:u (sd-face-relax-pnt-u relax-pnt)
:v (sd-face-relax-pnt-v relax-pnt)
:normal t
:dest-space :global) :normal))
(sd-call-cmds (progn
(CREATE_WORKPLANE :new
:pt_dir :origin wp-origin
:normal normal)
;; Rotate workplane about 90 degrees
(position_wp :current :rotate :axis :ref_wp :current :v
:rotation_angle (/ pi 2))
;; Bore the pilot hole
(tap_hole :drill-radius drill_rad
:drill-depth drill-depth
:drill-point (/ (* pi 118) 180)
:parts a_part)
;; Bore the tap hole
(tap_hole :drill-radius tap_rad
:drill-depth tap-depth
:drill-point pi
:parts a_part)
;; Changed color of the tapped face(s) to white
; (dolist (face facelist)
; (SET_FACE_COLOR face :rgb *tapped-face-color*)
; (sd-attach-item-attribute face "WG-THD" :values (list :tap tap))
; )
;; Bore the chamfer
(tap_hole :drill-radius cham_rad
:drill-depth 0.0
:drill-point (/ pi 2)
:parts a_part)
;; Delete the temporary workplane used for the bores
(delete_3d (sd-inq-curr-wp))
(if curr_wp (CURRENT_WP curr_wp))
))
(setq do_next_action t)
owner
)
)
(cleanup ()
(sd-call-cmds (progn
(if curr_wp (CURRENT_WP curr_wp))
)
)
)
)
:ok-action
'(if do_next_action
(let ((facelist
(sd-call-cmds (get_selection
:focus_type *sd-cylinder-seltype*
:select :by_feature (sd-active-cust-feat))))
(tmp-rad 0)
f cylinder nr)
(dolist (face facelist)
(setq cylinder (sd-inq-geo-props face))
(setq nr (sd-cylinder-radius cylinder))
(when (> nr tmp-rad)
(setq tmp-rad nr)
(setq f face)))
(when f
(sd-call-cmds (SET_FACE_COLOR f :rgb *tapped-face-color*)))
(display :hide)
;(make_drillhole)
;(cleanup)
)
)
:cancel-action '(cleanup)
)
(sd-defdialog 'verify_cust_feat
:dialog-title "Re-validate"
:dialog-control :sequential
:variables '(
(FEAT :value-type :feature
:prompt-test "Select a Design Info to validate"
:check-function #'(lambda(feat) (cust_feat::check-modify feat :any))
))
:ok-action
'(let ((dialog (cust_feat::load-feature-def-if-needed FEAT))
verifier
)
(unless dialog
(sd-display-error
"Can not validate a DesignInfo without access to its definition")
(sd-return-from-ok-action))
(setq verifier (get dialog :verifier))
(if verifier
(cust_feat:prim-set-cust-feat-validity (elan::sel_item-item feat)
(cust_feat::verify-feat feat verifier))
(cust_feat:prim-set-cust-feat-validity :unknown))
)
)
;;