; -*-Lisp-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Parametric Technology Corporation ; ; Description: Inquire and list face normal of planar faces and axis of cylindrical faces. Not supported. Use at your own risk. Provided by PTC-CoCreate Support. ; Created: Mar 2009 ; Language: Lisp ; Package: support ; ; (C) Copyright 2009 Prarmetric Technology Corporation, all rights reserved. ;Das Tool darf frei weitergegeben und auch im Internet zur Verfügung gestellt werden. Gemäss Rückfrage bei PTC (Herr H.H.) ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (in-package :support) (use-package :oli) (defvar *prev-face* nil) (defvar *ref-accuracy* "00000000000000") (defvar *ref-accuracy-num* 14) (defvar *table-dir-list* nil) (sd-create-logical-table "Vectors-LTab" :columns '(:face-type :x :y :z :sel-item :owner-item :owner) :types '(:string :number :number :number nil nil :string) :units '(nil nil nil nil nil nil nil) :contents '() ) (defun table-selection-create-label () (let (the-selection the-face) (setf the-selection (second (sd-get-display-table-selection "Vectors-DTab" :units :external))) (setf the-face (getf the-selection :sel-item )) (sd-put-buffer (format nil "cocreate_3d_note :action :create :note \"Test\" :items ~s :free_dim complete" the-face)) )) (defun table-selection-hilite-action (table) (let (the-selection the-face) (when *prev-face* (elan:persistent-unhilite-list *prev-face*)) (setf the-selection (second (sd-get-display-table-selection table :units :external))) (setf the-face (getf the-selection :sel-item )) (setf *prev-face* (list the-face)) (elan::persistent-hilite-list (list the-face)) (update_screen) ) ) (defun format-length-14-digits (ltab-name real-length row column) (declare (ignore ltab-name row column format-string)) ;; those parameters are not necessary in this format function (let (anumber the-split) (if (numberp real-length) (progn (setf anumber (sd-num-to-string real-length *ref-accuracy-num*)) (setf the-split (sd-string-split anumber ".")) (if (sd-string= (second the-split) *ref-accuracy*) (first the-split) anumber) ) "value of unexpected type") )) (sd-create-display-table "Vectors-DTab" :logicalTable "Vectors-LTab" :tableTitle "Normal Dir Table" :columns '(:face-type :x :y :z :owner) :columnSortUI t :bottomLine :apply-custom-close-help :customButtonLabel "Create Label" :customButtonAction '(table-selection-create-label) :formatFunctions '(nil format-length-14-digits format-length-14-digits format-length-14-digits) :selectionMode :single-row :selectionAction #'table-selection-hilite-action :customBottomForm t :applyAction nil :afterApplyBehavior nil :doubleClickAction nil ) (sd-create-grid-area "NORMAL-SEARCH-GA" (sd-get-display-table-custom-bottom-form "Vectors-DTab") :title "Suche in Teileliste" :frame t :x 0 :y 4 :width 125 :height 40 ) (sd-create-pushbutton-control "NORMAL-SEARCH-PB" "NORMAL-SEARCH-GA" :x 0 :y 0 :title "Suche" :pushAction '(let (the-selection the-owner the-owner-name) (setf the-selection (second (sd-get-display-table-selection "Vectors-DTab" :units :external))) (setf the-owner-name (getf the-selection :owner)) (print the-selection) (print the-owner-name) (print (list (list :column :instance-name :operation :equals :value the-owner-name))) (sd-create-browser-search "parcel-gbrowser" :name "THE-NORMAL-SEARCH" :title "Teil mit Normale" :case-sensitive nil :match :all :criteria (list (list :column :instance-name :operation :equals :value the-owner-name)) ) (sd-set-current-browser-search "parcel-gbrowser" "THE-NORMAL-SEARCH" :activate t :persistent t) ;(sd-delete-browser-search "parcel-gbrowser" "THE-NORMAL-SEARCH") ) ) (sd-defdialog 'inq_face_normal :dialog-title "Flaechennormalen" :variables '( ;;--------------local variables------------- (dir-list :value-type nil) ;;--------------visible variables----------- (MY_ACCURACY :value-type :positive-number :title "Gen. 10E-" :prompt-text "Geben Sie die Genauigkeit ein" :initial-value *ref-accuracy-num* :after-input (progn (sd-hide-display-table "Vectors-DTab") (setf dir-list nil) (setf *table-dir-list* dir-list) (sd-change-logical-table-contents "Vectors-LTab" :units '(nil nil nil nil nil) :contents dir-list ) (sd-set-variable-status 'MY_FACES :value nil ) (set-accuracy) ) ) (MY_FACES :selection (*sd-plane-seltype* *sd-cylinder-seltype*) :multiple-items t :face-part-allowed t :prompt-text "Waehlen Sie planare oder cylindrische Flaechen aus." :title "Flaechen" :no-highlight t :after-input (eval-faces) ) (SHOW_TAB :push-action (if *table-dir-list* (sd-show-display-table "Vectors-DTab") (sd-display-message "Tabelle ist leer. Bitte zuerst Flaechen waehlen") ) :toggle-type :wide-toggle :title "Letzte Tabelle zeigen" ) ) :local-functions '( (eval-faces () (let (face-props plane-list cyl-list the-dir the-parent) (dolist (item MY_FACES) (setf face-props (sd-inq-geo-props item :dest-space :global)) (setf the-parent (sd-inq-parent-obj item)) (cond ((sd-plane-p face-props) (setf the-dir (sd-plane-normal face-props)) ;(print (list "plane" (gpnt3d_x the-dir) (gpnt3d_y the-dir) (gpnt3d_z the-dir) item the-parent (sd-inq-obj-basename the-parent))) (push (list "plane" (gpnt3d_x the-dir) (gpnt3d_y the-dir) (gpnt3d_z the-dir) item the-parent (sd-inq-obj-basename the-parent)) plane-list)) ((sd-cylinder-p face-props) (setf the-dir (sd-cylinder-axis-dir face-props)) (push (list "cyl" (gpnt3d_x the-dir) (gpnt3d_y the-dir) (gpnt3d_z the-dir) item the-parent (sd-inq-obj-basename the-parent)) cyl-list)) (t (display "Keine gueltige Geometrie ausgewertet.")) ) );;end of dolist (setf dir-list (append plane-list cyl-list)) (setf *table-dir-list* dir-list) (sd-change-logical-table-contents "Vectors-LTab" :units '(nil nil nil nil nil) :contents dir-list ) (sd-show-display-table "Vectors-DTab") );;end of let ) (set-accuracy () (setf *ref-accuracy-num* MY_ACCURACY) (setf *ref-accuracy* "") (setf *ref-accuracy* (make-string MY_ACCURACY :initial-element #\0)) ) );end of local-functions :ok-action '(sd-hide-display-table "Vectors-DTab") :cleanup-action '(sd-hide-display-table "Vectors-DTab") );;end of defdialog