#|
Dialog Generator - Examples
Note: This is an example file showing concepts of the Integration Kit.
The code itself is not supported and will never be supported.
|#
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; condition: Online Help for Integration Kit should be installed
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; following examples are from Integration Kit Online Help
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Creo Elements/Direct Modeling
;; LISP examples extracted from dg_manual online help
;; description of Integration Kit Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :dg-examples)
(use-package :oli)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example # 1 starting at HTML line 332
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'quick_extrude
:dialog-title "Q. Extrude"
:variables
'((QE_PART
:value-type :part-incl-new
:modifies :contents
:title "Part"
:prompt-text "Identify part to be modified")
(QE_WP
:value-type :wp-with-profile
:title "Workplane"
:prompt-text "Identify workplane to extrude")
(DISTANCE
:value-type :length
:prompt-text "Specify distance to extrude"))
:ok-action
'(sd-call-cmds
(extrude :part qe_part
:wp qe_wp
:distance distance)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example # 2 starting at HTML line 445
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'dependent_enable_demo
:dialog-title "Valid Part"
:variables
'((COLOR :value-type :string
:after-input
(if (string= color "red")
(progn
(setq valid_part nil)
(sd-set-variable-status 'valid_part :enable nil))
(sd-set-variable-status 'valid_part :enable t)))
(VALID_PART
:value-type :part
:modifies NIL
:title "Part"
:initial-value nil))
:ok-action
'(pprint valid_part))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example # 3 starting at HTML line 516
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'dependent_check_demo2
:dialog-title "Valid Part2"
:variables
'((COLOR :value-type :string
:after-input
(case (colored-part-satisfies-name valid_part color)
(:error (setq valid_part nil))
(:ok t))) ;Do nothing
(VALID_PART
:value-type :part
:modifies NIL
:title "Part"
:prompt-text "Identify part to be shown"
:check-function
#'(lambda (a-part)
(colored-part-satisfies-name a-part color))))
:ok-action
'(pprint valid_part))
(defun colored-part-satisfies-name (new-part color)
;In: new-part {sel_item}
; color {string}
;Out: {:ok or (value :error a-message)}
(let ((name (sd-inq-obj-basename new-part)))
(if (and (string= color "red")
(char-equal (elt name 0) #\p))
(values :error "Sorry, a red part with name p... is NOT selectable")
:ok)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example # 4 starting at HTML line 593
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'full_extrude
:dialog-title "Full Extrude"
:variables
'((FE_PART
:value-type :part-incl-new
:title "Part"
:prompt-text "Identify part to be extruded"
:modifies :contents)
(FE_WP
:value-type :wp-with-profile
:title "Workplane"
:prompt-text "Identify workplane to extrude from"
:modifies nil
:after-input
(if (sd-inq-obj-parent-contents-read-only-p fe_wp)
(progn
(setq keep_wp t)
(sd-set-variable-status 'keep_wp :enable nil))
(sd-set-variable-status 'keep_wp :enable t)))
("-")
(DISTANCE
:value-type :length
:prompt-text "Specify distance to extrude")
(TO_PART
:value-type :part
:initial-value nil
:title "To Part"
:prompt-text "Identify to part"
:modifies nil)
(DIRECTION
:value-type :wp-normal
:title "Reverse")
("-")
(KEEP_WP
:value-type :boolean
:title "Keep WP"
:initial-value t
:initial-enable
(if fe_wp
(not (sd-inq-obj-parent-contents-read-only-p fe_wp))
t)))
:mutual-exclusion '(distance to_part)
:ok-action
'(sd-call-cmds
(extrude :part fe_part
:wp fe_wp
:distance distance
:to_part (if to_part to_part "")
(if (sd-vec-equal-p (sd-inq-wp-w-dir fe_wp) direction)
""
:reverse)
:keep_wp (if keep_wp :yes :no))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example # 5 starting at HTML line 2448
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'my_shared
:variables
'((A :value-type :boolean
:after-input
(sd-set-dialog-title
(format nil "Title ~A" (if a "ON" "OFF"))))
(NUM :value-type :number)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example # 6 starting at HTML line 2516
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'accepted1
:variables
'((A :value-type :boolean)
(NUM :value-type :number
:next-variable
(when a
(sd-accept-dialog))))
:ok-action
'(pprint (list a num)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example # 7 starting at HTML line 2531
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'accepted2
:variables
'((A :value-type :boolean)
(DO :push-action
(when a
(sd-accept-dialog))))
:ok-action
'(pprint (list a)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example # 8 starting at HTML line 2582
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'canceled
:variables
'((NUM :value-type :number
:toggle-type :invisible
:next-variable
(unless (number-is-legal num)
(sd-abort-dialog)))
(A_PART :value-type :part :modifies NIL))
:ok-action
'(create-parts num a_part))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example # 9 starting at HTML line 4334
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'my_scale
:variables
'((NUM :value-type :number
:initial-value 10
:after-input (setq scaled_num num))
(ENABLE :value-type :boolean
:initial-value t
:after-input
(sd-set-variable-status 'scaled_num :enable enable))
(SCALED_NUM
:value-type :scale
:minimum 1
:maximum 20
:initial-value 10
:after-input (setq num scaled_num)
:initial-enable t))
:ok-action
'(pprint (list 'scaled_num scaled_num)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #10 starting at HTML line 4481
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar *scale-index* nil "Currently used dynamic scale index.")
(defvar *scale-values* nil "Property list containing values for each index.")
(sd-defdialog 'multiple_drags
:dialog-title "Multiple Drags"
:variables
'((A_FACE
:value-type :face)
(DRAG
:value-type :dynamic-scale
:toggle-push-function #'my-toggle-push-function
:drag-callback (my-track-slider-value "drag callback")
:value-change-callback (my-track-slider-value "value change callback")))
:after-initialization-ui '(my-initialize-multiple-drags-scale)
:ok-action '(pprint (list 'scale-values *scale-values*)))
(defun my-toggle-push-function (index)
(format t "~%Index ~A pushed." index)
(my-set-drag-bounds index)
(setq *scale-index* index))
(defun my-set-drag-bounds (index)
(sd-set-dynamic-scale-bounds 'multiple_drags 'drag
:minimum (case index
(1 -10)
(otherwise -100))
:maximum (case index
(1 10)
(otherwise 100))
:increment (case index
(1 1)
(otherwise 10))))
(defun my-track-slider-value (text)
(let ((value (sd-get-slider-value 'multiple_drags 'drag)))
(format t "~%~A ~A with index ~A." text value *scale-index*)
(setf (getf *scale-values* *scale-index*) value)))
(defun my-initialize-multiple-drags-scale ()
(sd-disable-control
(sd-get-dynamic-slider-control 'multiple_drags 'drag 9))
(sd-set-togglebutton
(sd-get-dynamic-slider-control 'multiple_drags 'drag 1)
:callAction t)
(my-set-drag-bounds 1)
(setf *scale-values* nil))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #11 starting at HTML line 4822
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'calling_measure_dialog
:variables
'((PLANAR_FACE :value-type :face)
(STRAIGHT_EDGE :value-type :edge)
("-")
(CURVED_FACE :value-type :face
:after-input
(setq face_point
(sd-get-pnt-on-face curved_face :dest-space :global)))
(FACE_POINT :value-type :point-3d)
("-")
(CURVED_EDGE :value-type :edge
:after-input
(setq edge_point
(getf (sd-inq-edge-pnt curved_edge
:s 2
:coordinates t
:dest-space :global)
:coordinates)))
(EDGE_POINT :value-type :point-3d)
)
:ok-action
'(pprint
(list
:positive
(sd-call-cmds
(my_measure_dialog
:my_direction :face_normal planar_face
:my_vector :edge_tangent straight_edge :accept 34
:my_vector_list :edge_tangent curved_edge edge_point :accept 45))
:negative
(sd-call-cmds
(my_measure_dialog
:my_direction :neg_face_normal planar_face
:my_vector :edge_tangent straight_edge :reverse 34
:my_vector_list :neg_face_normal curved_face face_point 45))
) ;list
) ;pprint
) ;sd-defdialog
(sd-defdialog 'my_measure_dialog
:variables
'((MY_DIRECTION :value-type :measure-direction)
(MY_VECTOR :value-type :measure-vector)
(MY_VECTOR_LIST :value-type :measure-vector-list)
)
:ok-action '(list :dir my_direction :vec my_vector :vec-list my_vector_list))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #12 starting at HTML line 5080
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'filename_demo
:dialog-title "Filename"
:variables
'((PARTS :value-type :part
:modifies NIL
:multiple-items t)
(FILE :value-type :filename
:title "Save File"
:initialdirectory "/tmp"
:fileType :lisp))
:ok-action (progn
;...
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #13 starting at HTML line 5186
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'display_only
:dialog-title "Stretch Edge"
:variables
'((AN_EDGE :value-type :edge
:after-input
(setq old_length
(sd-call-cmds
(measure_dist :edge_length an_edge))))
(OLD_LENGTH :value-type :display-only
:display-units :length)
(NEW_LENGTH :value-type :length)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #14 starting at HTML line 5245
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'black_box
:dialog-title "Black Box"
:variables
'((PICTURE :value-type :image
:image-file "E:/Programs/CoCreate/OSD_Modeling_16.0.0.594/personality/pixmaps/moldbaseadvisor/prewbmp/bk.xpm")
(N1 :value-type :number)
(N2 :value-type :number))
:ok-action '(create-black-box n1 n2))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #15 starting at HTML line 5495
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'range_demo
:dialog-title "Ranges"
:variables
'((KEYWORDS1 :range (:val1 :val2 :val3))
(KEYWORDS2 :range ((:val1 :label "Val 1")
(:val2 :label "Val 2")
(:val3 :label "Val 3")))
("-")
(NUMBERS1 :range (1 2 3))
(NUMBERS2 :range ((1 :label "one")
(2 :label "two")
(3 :label "three")))
("-")
(SYMBOLS1 :range (val1 val2 val3))
(SYMBOLS2 :range ((val1 :label "Val 1")
(val2 :label "Val 2")
(val3 :label "Val 3")))
("-")
(STRINGS1 :range ("Val 1" "Val 2" "3"))
(STRINGS2 :range (("Val 1" :label "1.st Val")
("Val 2" :label "2.nd Val")
("3" :label "3.rd Val")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #16 starting at HTML line 5757
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'attach_country
:variables
'((REGION :value-type :string
:proposals ("North America" "Europe" "Asia"))
(A_PART :value-type :part :modifies NIL))
:ok-action
'(pprint (list region a_part)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #17 starting at HTML line 5832
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'Token_String
:variables
'((HEIGHT :value-type :measure-vector
:additional-token-string ":dir_len :edge_tangent")
(OBJECT :value-type :face
:multiple-items t
:show-select-menu t
:additional-token-string ":start"))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #18 starting at HTML line 6068
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'check_func
:variables
'((HEIGHT
:value-type :length
:check-function
#'(lambda (new-value)
(if (and (numberp new-value) (<= 0 new-value 10))
:ok
(values :error
"The input value is beyond the range [0 10]"))))
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #19 starting at HTML line 6283
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun number-in-bounds (candidate)
(cond ((<= candidate 10) :ok) ;==> accept candidate
((<= 10 candidate 20) :bad) ;==> manual decision
((> 20 candidate) ;==> reject candidate
(values :error "The value is too big!"))))
(sd-defdialog 'confirmed_number
:dialog-title "A number"
:variables
'((A_NUMBER
:value-type :number
:check-function number-in-bounds
:confirmation
(:bad
:prompt "The value is rather large, do you want to accept it?"
:severity :medium
))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #20 starting at HTML line 6443
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'next_demo
:dialog-title "Trim"
:variables
'((A_PART :value-type :part
:modifies NIL
:title "Part")
(HEIGHT :value-type :length)
(WIDTH :value-type :length)
(NEXT :push-action (trim-part a_part height width)))
:ok-action
'(trim-part a_part height width))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #21 starting at HTML line 6480
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'next2_demo
:dialog-title "Actions"
:variables
'((ENTITY :value-type :face)
(PREVIEW
:toggle-type :grouped-toggle
:initial-enable t
:push-action
(progn
(pprint "Preview Action")
(sd-set-variable-status 'preview :enable nil)
(sd-set-variable-status 'entity :enable nil)
(sd-set-variable-status 'next :enable nil)
(sd-set-variable-status 'un_preview :enable t)))
(UN_PREVIEW
:toggle-type :grouped-toggle
:initial-enable nil
:push-action
(progn
(pprint "Unpreview Action")
(sd-set-variable-status 'un_preview :enable nil)
(sd-set-variable-status 'preview :enable t)
(sd-set-variable-status 'entity :enable t)
(sd-set-variable-status 'next :enable t)))
(NEXT :push-action (pprint "Do it now"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #22 starting at HTML line 6541
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'confirm_in_after_input
:variables
'((ASK :value-type :boolean
:initial-value t)
(NUM :value-type :number
:after-input
(progn
(pprint "after-input-1")
(when (and ask
(eq (sd-display-question "Execute after-input-2?")
:yes))
(pprint "after-input-2")))))
:ok-action '(pprint (list :ask ask :num num)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #23 starting at HTML line 6588
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'confirm_on_after_input
:variables
'((ASK :value-type :boolean
:initial-value t)
(NUM :value-type :number
:after-input (pprint "after-input-1")
:next-variable (when ask :push))
(PUSH :push-action :bad
:confirmation
(:bad :dialog :question
:prompt "Execute after-input-2?"
:ok-cleanup (pprint "after-input-2"))
:toggle-type :invisible))
:ok-action '(pprint (list :ask ask :num num)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #24 starting at HTML line 6620
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'confirm_in_exit
:variables
'((ASK :value-type :boolean
:initial-value t))
:ok-action
'(progn
(pprint "ok-action-1")
(when (and ask
(eq (sd-display-question "Execute ok-action-2?")
:yes))
(pprint "ok-action-2"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #25 starting at HTML line 6644
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'confirm_on_exit
:variables
'((ok-action-1-executed :initial-value nil)
(ASK :value-type :boolean
:initial-value t)
(PUSH :push-action :bad
:confirmation
(:bad :dialog :question
:prompt "Execute ok-action-2?"
:ok-cleanup
(progn
(pprint "ok-action-2")
(setq ask nil)
(sd-accept-dialog))
:cancel-cleanup
(progn
(setq ask nil)
(sd-accept-dialog)))
:toggle-type :invisible))
:ok-action
'(progn
(unless ok-action-1-executed
(pprint "ok-action-1")
(setq ok-action-1-executed t))
(when ask
(sd-return-from-ok-action)))
:ok-action-next-variable
'(when ask
'push))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #26 starting at HTML line 6700
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'confirm_before_exit
:variables
'((ok-action-1-executed :initial-value nil)
(ASK :value-type :boolean
:initial-value t)
(DO_IT :push-action (ok-action-1)
:next-variable
(when ask
'push)
:toggle-type :invisible)
(PUSH :push-action :bad
:confirmation
(:bad :dialog :question
:prompt "Execute ok-action-2?"
:ok-cleanup
(progn
(pprint "ok-action-2")
(setq ask nil)
(sd-accept-dialog))
:cancel-cleanup
(progn
(setq ask nil)
(sd-accept-dialog)))
:toggle-type :invisible))
:local-functions
'((ok-action-1 ()
(unless ok-action-1-executed
(pprint "ok-action-1")
(setq ok-action-1-executed t))))
:ok-action
'(progn
(ok-action-1)
(when ask
(sd-return-from-ok-action)))
:ok-action-next-variable
'(when ask
'push))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #27 starting at HTML line 6759
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'position_part_demo
:dialog-title "Pos. Part"
:variables
'((A_PART :value-type :part
:modifies NIL
:title "Part")
(POSITIONING :position-part a_part)
(NEXT :push-action (install-part a_part))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #28 starting at HTML line 6771
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'position_wp_demo
:dialog-title "Pos. WP"
:variables
'((WP :value-type :wp
:title "Workplane")
(POSITIONING :position-wp wp)
(NEXT :push-action (install-wp wp))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #29 starting at HTML line 7034
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'toggle_type_demo
:dialog-title "Toggles"
:variables
'(("Boolean Variables")
(BOOL :value-type :boolean)
(BOOL-LEFT :value-type :boolean
:toggle-type :left-toggle)
(BOOL-RIG. :value-type :boolean
:toggle-type :right-toggle)
(BOOL-WIDE :value-type :boolean
:toggle-type :wide-toggle)
(BOOL-G1 :value-type :grouped-boolean)
(BOOL-G2 :value-type :grouped-boolean)
("Push Actions")
(PUSH :push-action (pprint "push"))
(PUSH-LEFT :push-action (pprint "push-l")
:toggle-type :left-toggle)
(PUSH-RIGHT :push-action (pprint "push-l")
:toggle-type :right-toggle)
(PUSH-WIDE :push-action (pprint "push-l")
:toggle-type :wide-toggle)
(PUSH-G1 :push-action (pprint "push-g1")
:toggle-type :grouped-toggle)
(PUSH-G2 :push-action (pprint "push-g1")
:toggle-type :grouped-toggle)
("Combined Bool/Push")
(BOOL-C1 :value-type :grouped-boolean)
(PUSH-C2 :push-action (pprint "push-c2")
:toggle-type :grouped-toggle)
("Indicator")
(NUM :value-type :number)
(NUM-IND :value-type :number
:toggle-type :indicator-toggle-data)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #30 starting at HTML line 7117
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'size_demo
:dialog-title "Size"
:variables
'(("Data Fields")
(NUM1/2 :value-type :number) ;default :size = :half
(NUM1/3 :value-type :number
:size :third)
("Booleans")
(BOOL1/2 :value-type :grouped-boolean) ;default :size = :half
(BOOL2/2 :value-type :grouped-boolean) ;default :size = :half
("-")
(B1/3 :value-type :grouped-boolean
:size :third)
(B2/3 :value-type :grouped-boolean
:size :third)
(B3/3 :value-type :grouped-boolean
:size :third)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #31 starting at HTML line 7365
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'expand_push
:dialog-title "Expand Push"
:variables
'((OBJECT :value-type :part
:modifies NIL)
(PARAMETERS :expand-shrink (a b))
(A :value-type :number
:initial-value 5)
(B :value-type :number
:initial-value 6)
(FILE :value-type :string)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #32 starting at HTML line 7451
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'expand_bool
:dialog-title "Expand Bool"
:variables
'((OBJECT :value-type :part
:modifies NIL)
(PARAMETERS :expand-shrink (a b)
:expand-shrink-toggle-type :boolean)
(A :value-type :number
:initial-value 5)
(B :value-type :number
:initial-value 6)
(FILE :value-type :string)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #33 starting at HTML line 7475
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'expand_pair
:dialog-title "Expand Pair"
:variables
'((OBJECT :value-type :part
:modifies NIL)
(PARAMETERS :expand-shrink (a b)
:expand-shrink-toggle-type :toggle-pair
:expand-token :with_ab
:shrink-token :without_ab)
(A :value-type :number
:initial-value 5)
(B :value-type :number
:initial-value 6)
(FILE :value-type :string)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #34 starting at HTML line 7514
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'expand_range
:dialog-title "Expand Range"
:variables
'((OBJECT :value-type :part
:modifies NIL)
(PARAMETERS :expand-shrink ((a) (b c) (d e f))
:expand-shrink-range ((:small :label "Small")
(:medium :label "Medium")
(:large :label "Large")))
(A :value-type :number
:initial-value 5)
(B :value-type :number
:initial-value 6)
(C :value-type :number
:initial-value 7)
(D :value-type :number
:initial-value 8)
(E :value-type :number
:initial-value 9)
(F :value-type :number
:initial-value 10)
(FILE :value-type :string)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #35 starting at HTML line 7710
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'external_expand_push
:dialog-title "External Push"
:variables
'((OBJECT :value-type :part
:modifies NIL)
(A :value-type :number
:initial-value 5)
(B :value-type :number
:initial-value 6)
(MORE :external-expand-shrink (c d)
:title "More Parameters"
:external-dialog-title "Detail Parameters")
(C :value-type :number
:initial-value 7)
(D :value-type :number
:initial-value 8)
(A_FACE :value-type :face)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #36 starting at HTML line 7742
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'external_expand_bool
:dialog-title "External Bool"
:variables
'((OBJECT :value-type :part
:modifies NIL)
(A :value-type :number
:initial-value 5)
(B :value-type :number
:initial-value 6)
(MORE :external-expand-shrink (c d)
:external-expand-shrink-toggle-type :boolean
:title "More Parameters"
:external-dialog-title "Detail Parameters")
(C :value-type :number
:initial-value 7)
(D :value-type :number
:initial-value 8)
(A_FACE :value-type :face)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #37 starting at HTML line 7842
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'my_area
:variables
'((NUM :value-type :number
:after-input
(setq str (format nil "x_~A" num)))
(FO :embedded-area-definition (create-my-uict-area)
:title "String"
:frame t
:height 73)
(STR :value-type :string
:initial-value "abc"
:uict-tb "MY_AREA-STRING-TB"
:uict-tx "MY_AREA-STRING-TX")
(A_PART :value-type :part
:modifies :contents
:title "Part"))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #38 starting at HTML line 7866
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun create-my-uict-area ()
(let ((area-name (sd-get-embedded-area-name 'my_area :fo)))
(sd-create-pushbutton-control "MY_AREA-STRING-TB" area-name
:x 0
:y 0
:width (- (sd-get-default-dialog-client-area-width) 20)
:height 22
:title "String")
(sd-create-text-control "MY_AREA-STRING-TX" area-name
:x 0
:y 30
:width (- (sd-get-default-dialog-client-area-width) 20)
:height 20))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #39 starting at HTML line 8029
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'do_with_item
:variables
'((TYPE :range (:edge :face))
(PUSH :push-action (progn)
:next-variable
(case type
(:edge 'do_edge)
(:face 'do_face)))
(DO_EDGE :value-type :edge
:toggle-type :invisible
:after-input (item-function do_edge)
:next-variable 'do_edge)
(DO_FACE :value-type :face
:toggle-type :invisible
:after-input (item-function do_face)
:next-variable 'do_face)
; .....
)
:local-functions
'((item-function (item)
(pprint (list :item item))
; .....
))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #40 starting at HTML line 8091
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'pick_several
:variables
'((OBJECTS)
(TYPE :range (:by-face :by-edge)
:next-variable
(case type
(:by-face 'p_face)
(:by-edge 'p_edge)))
(P_FACE :value-type :face
:toggle-type :invisible
:next-variable 'p_face
:after-input (push p_face objects))
(P_EDGE :value-type :edge
:toggle-type :invisible
:next-variable 'p_edge
:after-input (push p_edge objects)))
:ok-action
'(progn
(if (< (length objects) 4)
(progn
(sd-display-error "Pick more than 3 objects.")
(sd-return-from-ok-action))
(pprint objects)))
:ok-action-next-variable
'(case type
(:by-face 'p_face)
(:by-edge 'p_edge)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #41 starting at HTML line 8205
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'interpolate_demo
:dialog-title "Curve"
:variables
'((POINT_LIST) ;internal non displayed variable
(POINT_FEEDBACK_LIST) ;internal non displayed variable
(NEW_POINT ;internal input variable
:value-type :point-3d
:toggle-type :invisible
:prompt-text "Pick a point or press Back"
:after-input (push-point new_point))
(DEGREE
:range ((:linear :label "linear")
(:quadratic :label "quadratic")
(:cubic :label "cubic")))
(BACK :push-action (pop-point)))
:local-functions
'((PUSH-POINT (a-new-point)
(push a-new-point point_list)
(push (setup-point-feedback a-new-point) point_feedback_list)
(if (= (length point_feedback_list) 1)
(sd-set-variable-status 'back :enable t)))
(POP-POINT ()
(cleanup-point-feedback (pop point_feedback_list))
(pop point_list)
(unless point_list
(sd-set-variable-status 'back :enable nil))))
:prompt-variable 'new_point
:ok-action
'(progn
(interpolate-between-points degree point_list)
(loop ;repeat until no items left
(unless (pop-point)
(return)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #42 starting at HTML line 8242
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun setup-point-feedback (point)
(print (list :point point))
(progn "...")) ;returns feedback object
(defun cleanup-point-feedback (point)
(print (list :point point))
(progn "...")) ;return is not used
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #43 starting at HTML line 8606
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'my_help
:variables
'((bla :value-type :number))
:help-action
'(sd-display-url "http://www.ptc.com"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #44 starting at HTML line 8617
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'my_dyn_help
:variables
'((A_PART :value-type :part :modifies NIL)
(HELP_ON :range (:goodies :lego)))
:help-action
'(ecase help_on
(:goodies
(sd-display-url (format nil "~A/help/osdm/Common/documentation/goodies/Readme.html"
(sd-inq-install-dir))))
(:lego
(sd-display-url (format nil "~A/help/osdm/Common/documentation/integration_kit/home.html"
(sd-inq-install-dir))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #45 starting at HTML line 9144
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'a_non_embedded_subaction
:dialog-type :subaction
:embedded-ui nil ;; default = t
:variables
'((STRING_1 :value-type :string
:initial-value (first default))
(A_PART :value-type :part)
(STRING_2 :value-type :string
:initial-value (third default))
(ACCEPT :push-action (sd-accept-dialog)
:toggle-type :grouped-toggle)
(ABORT :push-action (sd-abort-dialog)
:toggle-type :grouped-toggle))
:ok-action
'(list string_1 a_part string_2))
(sd-defdialog 'calling_dialog_nemb
:dialog-title "Calling Dialog"
:variables
'((RESULT :value-type :list
:title "SA Result"
:subaction-name a_non_embedded_subaction
:default result
:after-input
(setq parameter1 (first result)))
(PARAMETER1 :value-type :display-only)
(PARAMETER2 :value-type :string))
:ok-action
'(pprint (list result parameter1 parameter2)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #46 starting at HTML line 9280
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'calling_push_dialog
:dialog-title "Calling Push Dialog"
:variables
'((DO_IT :push-action (progn)
:title "Do it"
:subaction-name a_non_embedded_subaction
:default (list parameter1 parameter2)
:after-input
(setq parameter1 (first do_it)))
(PARAMETER1 :value-type :display-only)
(PARAMETER2 :value-type :string))
:ok-action
'(pprint (list do_it parameter1 parameter2)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #47 starting at HTML line 9362
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'an_embedded_subaction
:dialog-type :subaction
:variables
'((STRING_1 :value-type :string
:initial-value (extract-first-string default))
(A_PART :value-type :part)
(STRING_2 :value-type :string
:initial-value (extract-second-string default))
(ACCEPT :push-action (sd-accept-dialog)
:toggle-type :grouped-toggle)
(ABORT :push-action (sd-abort-dialog)
:toggle-type :grouped-toggle))
:ok-action
'(subaction-ok-action string_1 string_2))
(sd-defdialog 'a_calling_dialog
:dialog-title "A Calling Dialog"
:variables
'((PARAMETER1 :value-type :string)
(RESULT :value-type :string
:title "SA Result"
:subaction-name an_embedded_subaction
:embedded-location parameter2
:default result)
(PARAMETER2 :value-type :string))
:ok-action
'(show-my-subaction-results result parameter1 parameter2))
(defun extract-first-string (a-str)
(when (sd-string-p a-str) (car (sd-string-split a-str " "))))
(defun extract-second-string (a-str)
(when (sd-string-p a-str) (cadr (sd-string-split a-str " "))))
(defun subaction-ok-action (str1 str2)
(format nil "~A ~A" str1 str2))
(defun show-my-subaction-results (res p1 p2)
(display
(format nil "~%Result : ~A~%Param1 : ~A~%Param2 : ~A~%"
res p1 p2)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #48 starting at HTML line 9415
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'visible_subdialog
:dialog-type :subaction
:embedded-ui nil ;;since calling dialog has no UI
:variables
'((A :value-type :number
:initial-visible (getf default :a-visible))
(B :value-type :number
:initial-visible (getf default :b-visible))
(C :value-type :number
:initial-visible (getf default :c-visible))
(D :value-type :number
:initial-visible (getf default :d-visible)))
:after-initialization
'(progn
(sd-set-dialog-title (getf default :dialog-title))
(sd-set-variable-status 'c :title (getf default :c-title)))
:ok-action '(format nil "~A-~A-~A-~A" a b c d))
(sd-defdialog 'caller_abc
:dialog-control :sequential
:variables
'((DUMMY :value-type :string
:subaction-name visible_subdialog
:default '(:a-visible t
:b-visible t
:c-visible t :c-title "abC"
:d-visible nil
:dialog-title "ABC"))))
(sd-defdialog 'caller_bcd
:dialog-control :sequential
:variables
'((DUMMY :value-type :string
:subaction-name visible_subdialog
:default '(:a-visible nil
:b-visible t
:c-visible t :c-title "bCd"
:d-visible t
:dialog-title "BCD"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #49 starting at HTML line 9801
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'pds_variant
:persistent-data-storage-variant-variable 'mode
:variables
'((MODE :value-type :keyword)
(BOOL :value-type :boolean
:persistent-data-storage t)
(NUM :value-type :number
:persistent-data-storage t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example #50 starting at HTML line 9830
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'pds_sub_variant
:persistent-data-storage-variant-variable 'mode
:dialog-type :subaction
:variables
'((MODE :initial-value (getf default :mode))
(S :value-type :string
:persistent-data-storage t)
(B :value-type :boolean
:persistent-data-storage t)
(D :value-type :face)))
(sd-defdialog 'my_pds_with_sub_on
:variables
'((BOOL :value-type :boolean
:initial-value t
:persistent-data-storage t
)
(SUB :value-type :list
:subaction-name pds_sub_variant
:default '(:mode :on))
))
(sd-defdialog 'my_pds_with_sub_off
:variables
'((BOOL :value-type :boolean
:initial-value t
:persistent-data-storage t
)
(SUB :value-type :list
:subaction-name pds_sub_variant
:default '(:mode :off))
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Creo Elements/Direct Modeling
;; LISP examples extracted from dg_3dcopilot online help
;; description of Integration Kit Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :dg-examples)
(use-package :oli)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example # 1 starting at HTML line 1473
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'co_view
:without-show t
:prompt-variable 'ref
:variables
'((POLESTAR)
(REF :selection (*sd-face-seltype*
*sd-edge-3d-seltype*
*sd-vertex-3d-seltype*)
:incl-position :3d
:after-input
(progn
(sd-delete-polestar POLESTAR)
(setq POLESTAR
(sd-create-polestar
:pick-token ":polestar_pick"
:forward-picking t
:components (sd-classic-polestar-components
(first ref) (second ref))
)
)
)
)
(POLESTAR_PICK
:value-type :point-3d-pick
:after-input
(set-copilot-view
(second ref)
(sd-inq-polestar-pick polestar :dir))
)
)
)
(defun set-copilot-view (pos dir)
(let ((vp-name (sd-inq-current-vp)))
(when pos
(set_vp_to_point vp-name pos)
;avoid sd-call-cmds in above interrupt action
;to obtain interpolated camera update.
)
(when dir
(sd-call-cmds
(set_vp_direction vp-name (sd-vec-subtract 0,0,0 dir))))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example # 2 starting at HTML line 1538
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'co_extrude
:variables
'((POLESTAR)
(WP :value-type :wp-with-profile
:incl-position :3d
:after-input
(progn
(sd-delete-polestar polestar)
(setq POLESTAR
(sd-create-polestar
:components
(list (list :type :line
:pick-token ":DISTANCE"
:origin (second WP)
:dir (sd-inq-wp-w-dir (first WP))
:backward-arrow nil
:mid-disc t))))
(sd-modify-quickview 'distance distance))
)
(DISTANCE
:value-type :length
:drag-from-polestar POLESTAR
:quickview-type :extrude-profile
:quickview-wp WP
)
(KEEP_PROFILE :value-type :boolean)
)
:ok-action
'(sd-call-cmds
(extrude
:wp (first wp)
:auto_direction :yes
:keep_wp :yes
:keep_profile (if keep_profile :yes :no)
:direction :+w
:distance distance
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example # 3 starting at HTML line 1592
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'co_parcels
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
:variables
`((POLESTAR)
(FEV
:selection (*sd-face-seltype*
*sd-edge-3d-seltype*
*sd-vertex-3d-seltype*)
:incl-position :3d
:after-input
(progn
(when POLESTAR
(sd-delete-polestar POLESTAR))
(setq POLESTAR
(sd-create-polestar
:pick-token ":DRAG_VARIABLE"
:components (sd-classic-polestar-components
(first FEV) (second FEV)))))
)
(DRAG_VARIABLE
:drag-from-polestar POLESTAR
:polestar-passenger t
:quickview-type :qv-parcel
:quickview-parcels (list (first FEV))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example # 4 starting at HTML line 1644
;; near
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog 'co_cable
:prompt-variable 'MY_POINT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
:variables
`(
(POLESTAR :initial-value nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(NEIGHBORING-PNTS :initial-value nil)
(DISC-DIRS :intiial-value nil)
(LINE-DIRS :intiial-value nil)
(FEEDBACKS :initial-value nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(MY_POINT
:selection *sd-vertex-3d-seltype*
:multiple-items nil
:wire-part-allowed t
:incl-position :3d
:after-input (make-polestar)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(USE-DISCS
:value-type :boolean
:after-input (make-polestar)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(USE-GLOBAL-XYZ
:value-type :boolean
:toggle-type :wide-toggle
:after-input (make-polestar)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(BLA
:value-type :boolean
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(POLESTAR_PICK
:drag-from-polestar POLESTAR
:polestar-passenger t
:quickview-type :lisp-feedback
:feedback-update-function update-feedback
:feedback-destroy-function destroy-feedback
:feedback-apply-function apply-quickview
:end-input-feedback
(when (and POLESTAR (not POLESTAR_PICK)) ; dragging cancelled
(sd-delete-polestar POLESTAR)
(setq POLESTAR nil))
)
)
:local-functions
'(
;;==========================================================================
(make-polestar ()
(sd-delete-polestar POLESTAR)
(setq POLESTAR
(sd-create-polestar
:origin (second MY_POINT)
:pick-token ":POLESTAR_PICK"
:components (get-polestar-components))))
;;==========================================================================
(get-polestar-components ()
(set-qp-data (first MY_POINT))
(let ((components nil))
(dolist (dir LINE-DIRS)
(push (list :type :line :dir dir :origin (first MY_POINT)) components))
(dolist (dir DISC-DIRS)
(push (list :type :disc :dir dir :origin (first MY_POINT)) components))
components)
)
;;==========================================================================
(set-qp-data (vertex)
(setq NEIGHBORING-EDGES
(sd-call-cmds (GET_SELECTION :select :edge_3d :by_vertex_3d vertex)))
(setq NEIGHBORING-PNTS nil)
(dolist (edge NEIGHBORING-EDGES)
(let* ((struc (sd-inq-edge-geo edge :dest-space :global))
(pnt (cond ((equal (sd-edge-start-pnt struc)
(second MY_POINT))
(sd-edge-end-pnt struc))
((equal (sd-edge-end-pnt struc)
(second MY_POINT))
(sd-edge-start-pnt struc)))))
(when pnt
(push pnt NEIGHBORING-PNTS))))
(setq LINE-DIRS nil)
(setq DISC-DIRS nil)
;; Build a list of non parallel vectors
(dolist (edge NEIGHBORING-EDGES)
;; only works for lines as we don't know whether it's the start or
;; end of the edge that is incident at our vertex. For lines this
;; does not matter.
(let ((sd-curve (sd-inq-geo-props edge :dest-space :global)))
(when (sd-line-p sd-curve)
(let ((dir (sd-line-dir sd-curve)))
(when (not (vec-parallel-to-any dir LINE-DIRS))
(setq LINE-DIRS (cons dir LINE-DIRS)))
)
)
)
)
(when USE-GLOBAL-XYZ
;; Use global x,y,z rather than the neighbouring edge basis.
(setq LINE-DIRS '(1,0,0 0,1,0 0,0,1))
(when USE-DISCS (setq DISC-DIRS LINE-DIRS))
)
;; We expect 1 or 2 dirs
(case (length LINE-DIRS)
(1 ;; Add two ortho normal lines
(setq LINE-DIRS (cons (vec-orthogonal (first LINE-DIRS)) LINE-DIRS))
(setq LINE-DIRS (cons (sd-vec-normalize (sd-vec-cross-product
(first LINE-DIRS)
(second LINE-DIRS)))
LINE-DIRS)
)
;; And make 2 planes !
(when USE-DISCS
(setq DISC-DIRS (cons (first LINE-DIRS) DISC-DIRS))
(setq DISC-DIRS (cons (second LINE-DIRS) DISC-DIRS))
)
)
(2 ;; Cross these two
(let ((dir (sd-vec-normalize (sd-vec-cross-product (first LINE-DIRS)
(second LINE-DIRS)))))
(unless (sd-vec-null-p dir)
(when USE-DISCS
(setq DISC-DIRS (cons dir DISC-DIRS))
)
(setq LINE-DIRS (cons dir LINE-DIRS))
)
)
)
)
)
;;==========================================================================
(update-feedback (quickview)
; 1. delete existing feedbacks
(destroy-feedback quickview)
; 2. create new feedbacks
(let ((pos (get-quickview-position quickview)))
(setf FEEDBACKS
(mapcar #'(lambda (start)
(sd-start-polyline-feedback
(list start pos) :color 1,0,0)
)
NEIGHBORING-PNTS)))
;; NB: would be faster if there were a sd-modify-polyline-feedback
;; so we could avoid deleting and re-creating on each step.
)
;;==========================================================================
(destroy-feedback (quickview)
(declare (ignore quickview))
(dolist (fb FEEDBACKS)
(sd-end-feedback fb))
(setf FEEDBACKS nil)
)
;;==========================================================================
(get-quickview-position (quickview)
(let* ((qv-result (sd-inq-quickview quickview :vector-transform))
(dir (getf qv-result :translation)))
(when dir
(sd-vec-add (second MY_POINT) dir))))
;;==========================================================================
(apply-quickview (qv)
(let ((pos (get-quickview-position qv)) ;; Get the new position
(part_sel ;; Find the part to modify, from the vertex
(sd-call-cmds
(get_selection :focus_type *sd-part-seltype*
:single_selection
:allow_wire_part
:select (second MY_POINT)))
)
)
(sd-delete-quickview 'POLESTAR_PICK)
;; delete the neighbouring edges and make new ones to the new pos
(sd-call-cmds
(progn
(dolist (edge NEIGHBORING-EDGES)
(curve_deletion edge)
)
(dolist (start-point NEIGHBORING-PNTS)
(straight_creation :wire_part part_sel :two_points start-point pos)
)
)
)
;; Update MY_POINT and the polestar
(let ((vertex_sel
(sd-call-cmds
(get_selection :focus_type *sd-vertex-3d-seltype*
:single_selection
:select pos)
)
)
)
;; using set-variable-status forces the after-input to be run, which
;; remakes the polestar
(sd-set-variable-status 'MY_POINT :value (list vertex_sel pos))
)
)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Vec Utils ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun vec-parallel-to-any (vec vec-list)
(dolist (v vec-list)
(when (vec-parallel v vec)
(return-from vec-parallel-to-any t))
)
nil
)
;; There's no sd-vec-parallel includes anti-parallel
(defun vec-parallel (vec1 vec2)
(let ((uvec1 (sd-vec-normalize vec1))
(uvec2 (sd-vec-normalize vec2)))
(or (equalp uvec1 uvec2)
(equalp uvec1 (sd-vec-scale uvec2 -1.0))))
)
(defun vec-orthogonal (vec)
(let ((x (gpnt3d_x vec))
(y (gpnt3d_y vec))
(z (gpnt3d_z vec)))
;scalar product must be zero.
(if (or (> (* x x) 0) (> (* y y) 0))
(setq new-x (- y) new-y (- x) new-z 0)
(setq new-x (- z) new-y 0 new-z (- x)))
(sd-vec-normalize
(make-gpnt3d :x new-x :y new-y :z new-z)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
#|
Minimized UI with sd-defdialog - Additional Example
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 :dg-examples)
(use-package '( :oli))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; define a dialog with some buttons specified as ':minimal-ui T'
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-defdialog
'present_minimized_ui_chances
:dialog-control :parallel
:dialog-title "Minimal UI example"
:after-initialization-ui
'(when (sd-control-visible-p "PRESENT_MINIMIZED_UI_CHANCES")
(display "To see the possibilities of Minimized UI you should use the
Tools/Customize command to push the ICON 'Minimized UI' out of 'SolidDesigner/Test' group into a toolbar of your choice and call it from over there.")
)
:variables
'(
(ROT_ANGLE
;; this variable will be visible in minimized UI
:minimal-ui T
:minimal-ui-title "Absolute Angle"
:minimal-ui-width 25 ;; the width in GRID unit
:title "Abs Angle"
:value-type :angle
:proposals ()
:auto-add-proposals T
)
(MOVE_LENGTH
;; this variable will be visible in minimized UI
:minimal-ui T
:title "Length"
:value-type :length
:proposals '()
:auto-add-proposals T
)
(COMMENT
;; this variable will NOT be visible in minimized UI, but will be shown
;; when user requests the complete UI
:title "Comment"
:value-type :string
:initial-optional T
:prompt-text "What do you want to tell me? [string]"
:show-input-tool
(sd-show-general-text-editor
;:title (sd-get-control-title (sd-get-variable-ui-properties 'present_minimized_ui_chances :comment :TB))
:title "What do you want to tell me?"
:initialText comment
:position `(,(sd-get-variable-ui-properties 'present_minimized_ui_chances :comment :TB)
:leftcenter)
)
:hide-input-tool (sd-hide-general-text-editor)
:after-input
(progn
(pprint (format nil "I would like to tell you: ~A " comment))
)
:proposals '()
:auto-add-proposals T
)
(HIDDEN_TEXT
;; this variable will NOT be visible at all! (regardless of minimized or not)
:toggle-type :invisible
:prompt-text "What additional thing do you want to tell me? [string]"
:value-type :string
:after-input (pprint "There's only a hidden secret not to be told.... ")
)
)
:ok-action
'(display (format nil "You entered ~%~A ~A~%~A ~A~%~A ~A~%"
"a rotation angle of " (sd-num-to-string (sd-sys-to-user-units :angle rot_angle))
"a move length of " (sd-num-to-string (sd-sys-to-user-units :length move_length))
"and (may be) the comment " (or comment "")
))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; to have access to the miminized UI the UI behaviour has
;; to be set to :on-request. Therefore we add an available
;; command now:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sd-define-available-command "SolidDesigner" "Test" "Present Minimized UI"
:commandTitle "Minimized UI"
:action "present_minimized_ui_chances"
:description "Show the possibilities of minimized UI of OSD 12.x"
:ui-behavior :on-request
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; well these (normally default) settings have to be set
;; to work with UI on request and minimal UI's
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(ui_settings :USE-VP-BUTTONS :ON :OPTION-DIALOG-POS :LEFT)
; END of Example
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; END of Example