|#
(in-package :EXAMPLES)
(use-package :OLI)
;;----- Logical Table ---------------------------------------------------------
(sd-create-logical-table "Standard-Pipe-Bends"
:columns '(:pipe_radius :bend_radius :bend_angle)
:columnNames '("Pipe Radius" "Bend Radius" "Angle")
:types '(:length :length :angle)
:units '(:mm :mm :deg)
:contents '(( 5 5 15) ( 5 5 30) ( 5 5 45) ( 5 5 60) ( 5 5 90)
( 5 10 15) ( 5 10 30) ( 5 10 45) ( 5 10 60) ( 5 10 90)
( 5 20 15) ( 5 20 30) ( 5 20 45) ( 5 20 60) ( 5 20 90)
(10 10 15) (10 10 30) (10 10 45) (10 10 60) (10 10 90)
(10 15 15) (10 15 30) (10 15 45) (10 15 60) (10 15 90)
(10 20 15) (10 20 30) (10 20 45) (10 20 60) (10 20 90)
(10 30 15) (10 30 30) (10 30 45) (10 30 60) (10 30 90)
))
;;----- Display Table ---------------------------------------------------------
(sd-create-display-table "STANDARD-PIPE-BENDS"
:tableTitle "Standard Pipe Bends"
:logicalTable "Standard-Pipe-Bends"
:columns '(:pipe_radius :bend_radius :bend_angle)
:applyColumns '(:bend_radius :bend_angle)
:selectionMode :single-row
:applyAction :default-tokens)
;;----- Table show and hide functions -----------------------------------------
(defun show-standard-bend-table (&rest args)
(let ((type (pop args))
(pipe-radius (getf args :pipe-radius))
(bend-radius (getf args :bend-radius))
(bend-angle (getf args :bend-angle))
(show-table nil))
(if pipe-radius
(when (sd-read-logical-table-row "Standard-Pipe-Bends"
:pList `(:pipe_radius ,pipe-radius))
;; Yes, there is at least one row with a correct pipe radius
(sd-filter-display-table "STANDARD-PIPE-BENDS"
:column :pipe_radius
:test1 :equal
:value1 pipe-radius)
(setq show-table t))
(progn
(sd-reset-display-table-filter "STANDARD-PIPE-BENDS"
:column :pipe_radius)
(setq show-table t)))
(when show-table
(case type
(:radius
(sd-reset-display-table-filter "STANDARD-PIPE-BENDS"
:column :bend_radius)
(if bend-angle
(when (sd-read-logical-table-row "Standard-Pipe-Bends"
:pList `(:bend_angle ,bend-angle))
(sd-filter-display-table "STANDARD-PIPE-BENDS"
:column :bend_angle
:test1 :equal
:value1 bend-angle)
(setq show-table t))
(progn
(sd-reset-display-table-filter "STANDARD-PIPE-BENDS"
:column :bend_angle)
(setq show-table t))))
(:angle
(sd-reset-display-table-filter "STANDARD-PIPE-BENDS"
:column :bend_angle)
(if bend-radius
(when (sd-read-logical-table-row "Standard-Pipe-Bends"
:pList `(:bend_radius ,bend-radius))
(sd-filter-display-table "STANDARD-PIPE-BENDS"
:column :bend_radius
:test1 :equal
:value1 bend-radius)
(setq show-table t))
(progn
(sd-reset-display-table-filter "STANDARD-PIPE-BENDS"
:column :bend_radius)
(setq show-table t))))))
(when show-table
(sd-show-display-table "STANDARD-PIPE-BENDS"
:position '("PIPE-OPTIONS-OPT-CONT-BEND_ANGLE-TB"
:leftcenter -10 -20)))))
;;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(defun hide-standard-bend-table ()
(sd-hide-display-table "STANDARD-PIPE-BENDS" :ignorePin t))
;;----- Pipe Dialog -----------------------------------------------------------
(sd-defdialog 'pipe
:dialog-title "Piping"
:variables
'(
;; local variables:
(BACK-STATES :initial-value nil)
(CURR-WP :initial-value (sd-inq-curr-wp))
(PIPE-WP :initial-value
(let ((name (sd-gen-obj-basename :workplane
:prefix "pipe-plane")))
(sd-call-cmds (create_workplane :new :name name))
(sd-pathname-to-obj (sd-pathlist-to-pathname
(list "/" name)))))
(PIPE-PROFILE :initial-value nil)
(DIR-FBACK :initial-value nil)
(PREVIEW-FBACK :initial-value nil)
(NEXT-PERFORMED :initial-value nil)
(STRAIGHT :initial-value t) ;; straight or bend section?
(STRAIGHT-LEN :initial-value nil)
(BEND-AXIS :initial-value nil)
;; dialog vaiables:
(PIPE_PART :value-type :part-incl-new
:title "Part"
:after-input (handle-ok-next-action))
(ORIGIN :value-type :point-3d
:title "Origin"
:initial-value (sd-inq-wp-origin pipe-wp)
:after-input (progn
(handle-ok-next-action)
(sd-call-cmds (position_wp pipe-wp
:pt_dir
:origin origin
:normal :w :done))
(start-dir-fback)))
(DIRECTION :value-type :measure-direction
:built-in-feedback nil
:title "Direction"
:initial-value
(let ((dir (sd-inq-wp-w-dir pipe-wp)))
(setq dir-fback (sd-start-direction-feedback :point origin
:direction dir
:disc nil))
(list dir))
:check-function
#'(lambda (new-dir)
(if (first bend_dir)
(if (vec-collinear-p (first new-dir) (first bend_dir))
(values :error "Direction collinear to specified Bend direction not allowed.")
:ok)
:ok))
:after-input (progn
(handle-ok-next-action)
(sd-call-cmds (position_wp pipe-wp
:pt_dir
:origin origin
:normal (first direction)
:done))
(start-dir-fback)))
(RADIUS :value-type :positive-length
:title "Radius"
:after-input (progn
(handle-ok-next-action)
(when pipe-profile
(sd-call-cmds (delete_2d :all_2d)))
(sd-call-cmds (circle :cen_rad 0,0 radius))
(sd-call-cmds (c_point 0,0))
(when (and bend_radius
(< bend_radius radius))
;; invalid bend_radius for this radius => reset
(setq bend_radius nil))
(setq pipe-profile t)))
("Straight")
(STRAIGHT_LENGTH :value-type :positive-length
:title "Length"
:after-input (switch-to-straight))
(STRAIGHT_TO_PNT :value-type :point-3d
:title "To Pnt"
:after-input (switch-to-straight))
("Bend")
(BEND_RADIUS :value-type :positive-length
:title "Radius"
:toggle-type :toggle-data
:show-input-tool
(sd-subscribe-event *sd-interactive-event*
#'show-standard-bend-table
:radius
:pipe-radius radius
:bend-radius bend_radius
:bend-angle bend_angle)
:hide-input-tool
(progn
(sd-unsubscribe-event *sd-interactive-event*
#'show-standard-bend-table)
(hide-standard-bend-table))
:check-function #'(lambda (new-radius)
(if (or (not radius)
(>= new-radius radius))
:ok
(values :error "Bend radius less than pipe radius not allowed.")))
:after-input (switch-to-bend))
(BEND_ANGLE :value-type :angle
:title "Angle"
:initial-optional t
:show-input-tool
(sd-subscribe-event *sd-interactive-event*
#'show-standard-bend-table
:angle
:pipe-radius radius
:bend-radius bend_radius
:bend-angle bend_angle)
:hide-input-tool
(progn
(sd-unsubscribe-event *sd-interactive-event*
#'show-standard-bend-table)
(hide-standard-bend-table))
:after-input (switch-to-bend))
(BEND_DIR :value-type :measure-direction
:built-in-feedback nil
:title "Direction"
:initial-optional t
:check-function
#'(lambda (new-dir)
(if (first direction)
(if (vec-collinear-p (first new-dir) (first direction))
(values :error "Bend direction collinear to Direction not allowed.")
:ok)
:ok))
:after-input (switch-to-bend))
("-")
(NEXT :toggle-type :grouped-toggle
:title "Next"
:push-action (next-action))
(BACK :toggle-type :grouped-toggle
:title "Back"
:initial-enable nil
:push-action (back-action))
)
:mutual-exclusion '(straight_length straight_to_pnt bend_radius)
:local-functions
;;--------------
'((cleanup ()
(sd-end-feedback preview-fback)
(sd-end-feedback dir-fback)
(sd-call-cmds (delete_3d pipe-wp))
(sd-call-cmds (current_wp curr-wp)))
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(handle-ok-next-action ()
(setq next-performed nil)
(sd-enable-must-variable-check))
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(vec-collinear-p (vec1 vec2)
(let ((angle (sd-vec-angle-between vec1 vec2)))
(if (or (< (abs angle) (sd-inq-default-geo-resolution))
(< (abs (- angle PI)) (sd-inq-default-geo-resolution)))
t
nil)))
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(start-dir-fback ()
(when (and origin (first direction))
(sd-end-feedback dir-fback)
(setq dir-fback (sd-start-direction-feedback
:point origin
:direction (first direction)
:disc nil))))
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(end-dir-fback ()
(sd-end-feedback dir-fback))
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(start-preview-fback ()
(end-preview-fback)
(if straight
(progn
(if straight_length
(setq straight-len straight_length)
(setq straight-len
(sd-call-cmds (measure_dist :between_points
origin
straight_to_pnt
:direction (first direction)))))
(setq preview-fback (sd-start-direction-feedback
:point (sd-vec-translate origin
(first direction)
straight-len)
:direction (first direction))))
;; ELSE: bend preview
(if (and bend_radius bend_angle bend_dir)
(let* ((cross1 (sd-vec-cross-product (first direction)
(first bend_dir)))
(cross2 (sd-vec-cross-product cross1 (first direction)))
(point (sd-vec-translate origin cross2 bend_radius)))
(setq preview-fback (sd-start-direction-feedback
:point (sd-vec-rotate origin
bend_angle
:point point
:direction cross1)
:direction (sd-dir-rotate
(first direction)
bend_angle
:point point
:direction cross1)))
(setq bend-axis (list point cross1)))
(setq bend-axis nil))))
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(end-preview-fback ()
(sd-end-feedback preview-fback))
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(switch-to-straight ()
(handle-ok-next-action)
(setq straight t)
(sd-set-variable-status 'bend_angle :optional t)
(sd-set-variable-status 'bend_dir :optional t)
(setq bend_angle nil)
(setq bend_dir nil)
(start-preview-fback))
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(switch-to-bend ()
(handle-ok-next-action)
(setq straight nil)
(sd-set-variable-status 'bend_radius :optional nil)
(sd-set-variable-status 'bend_angle :optional nil)
(sd-set-variable-status 'bend_dir :optional nil)
(start-preview-fback))
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(next-action ()
(setq next-performed t)
(sd-disable-must-variable-check)
(when (and pipe_part origin direction radius)
(if straight
(when straight-len ;; calculated in start-preview-fback
(end-dir-fback)
(end-preview-fback)
;; remember current model state:
(push (list (sd-set-model-checkpoint) origin direction)
back-states)
;; perform extrude and position_wp:
(sd-call-cmds (extrude :part pipe_part :wp pipe-wp
:distance straight-len :keep_wp :yes))
(sd-call-cmds (position_wp pipe-wp :translate :dir_len
(first direction) straight-len))
(setq origin (sd-inq-wp-origin pipe-wp))
(start-dir-fback))
;; ELSE: perform bend operation:
(when bend-axis ;; calculated in start-preview-fback
(end-dir-fback)
(end-preview-fback)
;; remember current model state:
(push (list (sd-set-model-checkpoint) origin direction)
back-states)
;; perform turn and position_wp:
(sd-call-cmds (turn :part pipe_part :wp pipe-wp
:axis (first bend-axis) (second bend-axis)
:rotation_angle bend_angle
:keep_wp :yes))
(sd-call-cmds (position_wp pipe-wp :rotate
:axis (first bend-axis) (second bend-axis)
:rotation_angle bend_angle
:done))
(setq bend_dir nil)
(setq origin (sd-inq-wp-origin pipe-wp))
(setq direction (list (sd-inq-wp-w-dir pipe-wp)))
(start-dir-fback))))
(when back-states
(sd-set-variable-status 'back :enable t)))
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(back-action ()
(when back-states
(let ((state (pop back-states)))
(end-dir-fback)
(sd-return-to-model-checkpoint (first state))
(setq origin (second state))
(setq direction (third state))
(start-dir-fback))
(unless back-states
(sd-set-variable-status 'back :enable nil))))
) ;; end of local functions
:ok-action '(progn
(unless next-performed
(next-action))
(cleanup))
:cancel-action '(cleanup)
)
;