(in-package :thread) (use-package :oli) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; example how to use the function sd-am-create-standard-view ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Anpassungen fuer deutsche Lokalisation und Korrektur der Variablen mit ;; Proposal-Angaben damit diese korrekt funktionieren ;; R. Roth; Fa. GEZE 25.10.2002 ;;==================================== ;; os / 09.03.2004 ;; feedback für a-dir-reverse hinzugefügt ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (sd-defdialog 'thread_extension :dialog-title "Gewinde Def." :after-initialization '(progn (trace oli::sd-define-thread oli::sd-inq-thread oli::sd-destroy-thread ) (setf profile nil) ) :mutual-exclusion '( (nomi-dia nomi-dia-inch) (pitch1 TPI1)) :variables '( (t-feedbacks :initial-value nil) ;; all feedbacks shown (result :initial-value nil) ;; saved return value of sd-*-thread functions (props :initial-value nil) ;; cylinder face properties (axis :initial-value nil) (center :initial-value nil) (a-cyl-face :selection *sd-cylinder-seltype* :title "Zyl. Flaeche" :check-function #'(lambda (this-face) (if (sd-cylinder-p (SD-INQ-GEO-PROPS this-face)) :ok (values :error "Keine Zylinderflaeche gewählt. Gewindedef. nur bei zylindrischen Flaechen moeglich."))) :after-input (let (start radius) (dolist (a-fb t-feedbacks) (sd-end-point-feedback a-fb)) ;; remove old feedback (setf props (sd-inq-geo-props a-cyl-face :dest-space :global)) (setf center (sd-cylinder-center props)) ;; really the center , also in axis direction! (setf axis (sd-cylinder-axis-dir props)) (setf start (sd-cylinder-start-dir props)) ;; this is for rotaion, (setf radius (sd-cylinder-radius props)) (push ;; center of cylinder (sd-start-direction-feedback :point center :direction axis :disc t :color 0,0,1) t-feedbacks) (sd-set-variable-status 't-define :enable t) (sd-set-variable-status 't-inq :enable t) (sd-set-variable-status 't-destroy :enable t) ) ;; end after-input ) ;; end a-cylface ;; ------------------------------------------------------------------- ("metrisch") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Einfuehrung der Variablen nomi-dia; pitch1 und TPI1 vom Typ string ;; da proposals nur vom Typ string sein koennen!!! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (nomi-dia :title "Nenn-D." :value-type :string :proposals '("6" "8" "10" "12") ) (pitch1 :title "Steigung" :value-type :string :proposals '("1" "1.25" "1.5" "1.75") ) ("inch") (nomi-dia-inch :title "Nenn-D." :value-type :string :proposals '("#12" "1/4" "3/8" "1" "1 1/2") ) (TPI1 :title "Steigung" :value-type :string :initial-value "" :proposals '("28" "24" "20" "18" "14") ) ("-") (core-dia :title "Kern-D." :toggle-type :indicator-toggle-data :value-type :positive-length ) (profile :toggle-type :indicator-toggle-data :title "Gew.-art" :range (:BSW :BSF :BSP :UNC :UNF :NPT :M :MF :TR :S :R :E) ) (thread-type :title "Typ" :range ( :Aussen :Innen) ) (chamfer :title "vorh. Fase einbeziehen" :value-type :boolean :toggle-type :wide-toggle :initial-value T ) (thread-name :title "Name" :value-type :string :initial-value "" ) (a-dir-reverse :title "Umkehren" :value-type :boolean :toggle-type :wide-toggle :after-input (progn (dolist (a-fb t-feedbacks) (sd-end-point-feedback a-fb)) (setf axis (make-gpnt3d :x (* -1 (gpnt3d_x axis)) :y (* -1 (gpnt3d_y axis)) :z (* -1 (gpnt3d_z axis)))) (push ;; center of cylinder (sd-start-direction-feedback :point center :direction axis :disc t :color 0,0,1) t-feedbacks) );;progn ) ;; ------------------------------------------------------------------- (reset :title "Neu" :toggle-type :right-toggle :push-action (setf nomi-dia nil pitch nil nomi-dia-inch nil TPI nil core-dia NIL thread-type :Innen chamfer nil profile nil thread-name nil a-dir-reverse nil ) ) ;; end clear (t-define :initial-enable NIL :toggle-type :wide-toggle :title "Anwenden" :push-action (progn (setf result (oli::sd-define-thread a-cyl-face ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Variablen nomi-dia; pitch1 und TPI1 vom Typ string ;; werden wieder in float umgewandelt, damit sd-define-thread die parameter ;; richtig übernehmen kann. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; :nominal-diameter (if (not (eql nomi-dia NIL)) (float (read-from-string nomi-dia))) :nominal-diameter-inch nomi-dia-inch :core-diameter core-dia :pitch (if (not (eql pitch1 NIL)) (float (read-from-string pitch1))) :TPI (if (not (eql TPI1 NIL)) (float (read-from-string TPI1))) :thread-type (case thread-type (:Innen :inner) (:Aussen :outer)) :thread-unit (if nomi-dia :metric :inch) :thread-profile profile :thread-color (sd-color-to-rgb 16753049) :include-chamfer chamfer :thread-direction (if a-dir-reverse :REVERSE-CYL-AXIS :CYL-AXIS) :thread-name thread-name ) ) (unless result (display "Keine Gewinde erzeugt - Siehe Trace")) ) ) ;; end t-define ;; ------------------------------------------------------------------- ("Gewinde abfragen") (t-inq :initial-enable NIL :toggle-type :wide-toggle :title "Abfragen" :push-action (progn (setf result (oli::sd-inq-thread a-cyl-face)) (if result (progn (display (format nil "thread detected~%~%~{:~A ~A~%~}~%look also to trace output in concole~%" (nthcdr 2 result))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Variablen nomi-dia; pitch und tpi vom Typ float ;; werden wieder in string umgewandelt, damit diese im Dialogfenster wieder ;; richtig angezeigt werden koennen. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (getf result :nominal-diameter-inch) (setf nomi-dia-inch (getf result :nominal-diameter-inch)) (setf nomi-dia (sd-num-to-string (getf result :nominal-diameter))) ) (setf core-dia (getf result :core-diameter)) (if (getf result :TPI) (setf TPI1 (sd-num-to-string (getf result :tpi))) (setf pitch1 (sd-num-to-string (getf result :pitch))) ) (setf thread-type (case (getf result :thread-type)(:inner :Innen ) (:outer :Aussen ))) (setf profile (getf result :thread-profile)) (setf chamfer (getf result :include-chamfer)) (setf a-dir-reverse (NOT (sd-vec-equal-p (getf result :thread-direction) (sd-cylinder-axis-dir props)))) (setf thread-name (getf result :thread-name)) ) ; end progn (display "Keine sd-define-thread Informationen verfuegbar")) ) ) ;; end t-inq ;; ------------------------------------------------------------------- ("Gewinde entfernen") (t-destroy :initial-enable NIL :toggle-type :wide-toggle :title "Entfernen" :push-action (progn (setf result (oli::sd-destroy-thread a-cyl-face)) (if result (display "Gewinde entfernt") (display "Keine Gewindeinformation verfuegbar oder Gewinde nicht entfernt - Siehe Trace")) ) ) ;; end t-destroy ) ;; end variables :cleanup-action '(progn (dolist (a-fb t-feedbacks) (sd-end-point-feedback a-fb)) ;; remove old feedback (untrace oli::sd-define-thread oli::sd-inq-thread oli::sd-destroy-thread ) ) ) ;; end ; END of Example