;;--------------------------------------------------------------------------* ;; Dateiname: SD_Import-ordnen.lsp ;; Version : 3.1 ;; Datum : 14.01.2016 ;; Author : BFE ;;--------------------------------------------------------------------------* ;; Unterstützt das Einordnen gewählter Teile in eine Struktur ;;--------------------------------------------------------------------------* ;;Versionierung ;; 1.0 erste Version ;; 2.0 neue Funktionen: ausblenden, BG erzeugen ;; 3.0 Wahlfunktion Verschieben od. Exemplar erstellen ;; 3.1 Display Feld hinzu + VP optimiert ;; 4.0 Umstrukturierung und Ergänzung => in VP darstellen ;;--------------------------------------------------------------------------* ; ä Ì Ä Ø Î Î Î Ú ü Ï Ü Û ß Þ ° ³ ; --------------------------------------------------------------------------* (in-package :BFE-Tools) (use-package :oli) ;;--------------------------------------------------------------------------* (sd-defdialog 'Import-ordnen :dialog-title "Import-ordnen" :toolbox-button t :after-initialization '(progn (when (sd-inq-vp-exists-p "geordnet") (sd-call-cmds (delete_vp "geordnet")) );;when );;progn :variables '( ("Baugruppe erzeugen") (BG-neu :value-type :string :title "BG Name" :prompt-text "Namen der neuen Baugruppe angeben" :initial-optional t ;:after-input ; (when BG-neu (SD-SET-VARIABLE-STATUS 'Ziel-BG :optional t)) ) (Ziel-BG :value-type :assembly :title "Zielbaugruppe" :prompt-text "Zielbaugruppe angeben" :initial-value (sd-pathname-to-obj "/") ) (button-bg :push-action (BG-erzeugen) :title "BG erzeugen" :toggle-type :wide-toggle ) ("Elemente verschieben") (check-verschieben :title "Verschieben" :toggle-type :grouped-toggle :value-type :boolean :initial-value t ) (check-exemplar :title "Exemplar" :toggle-type :grouped-toggle :value-type :boolean :initial-value nil ) (Teil-BG :selection *sd-3d-object-seltype* :title "Teil/BG" :prompt-text "zu verschiebende(s) Teil/BG angeben" :multiple-items t :after-input (when teil-bg (if (equal ausblenden t) ;#funktion wenn wahr (progn (dolist (teil-bg-einzeln teil-bg) (sd-call-cmds (remove_from_vp_drawlist (sd-inq-current-vp) (SD-INQ-OBJ-PATHNAME teil-bg-einzeln))) ;Teil ausblenden (when EntferneFarbe (DeleteFaceColor teil-bg-einzeln)) (when EntferneExemplarFarbe (DelExCol teil-bg-einzeln)) );;dolist (when BG-neu (BG-erzeugen)) (verschieben) (sd-call-cmds (remove_from_vp_drawlist (sd-inq-current-vp) (SD-INQ-OBJ-PATHNAME Ziel-BG))) (when neues-Fenster (Objekte_im_neuen_Fenster_darstellen Ziel-BG t)) );end progn ;#funktion wenn falsch (progn (dolist (teil-bg-einzeln teil-bg) (when EntferneFarbe (DeleteFaceColor teil-bg-einzeln)) (when EntferneExemplarFarbe (DelExCol teil-bg-einzeln)) );;dolist (when BG-neu (BG-erzeugen)) (when EntferneFarbe (DeleteFaceColor teil-bg-einzeln)) (verschieben) (when neues-Fenster (Objekte_im_neuen_Fenster_darstellen Ziel-BG t)) );;progn );end if );end when teil-bg );;Teil-BG ;(Besitzer ; :value-type :assembly ; :title "Besitzer" ; :prompt-text "Besitzer fuer neue Baugruppe angeben" ; :initial-optional t ;) ("Optionen") (ausblenden :value-type :boolean :toggle-type :wide-toggle :title (sd-multi-lang-string "hide after selection" :german "Teil ausblenden") :initial-value t );;ausblenden (EntferneFarbe :value-type :boolean :toggle-type :wide-toggle :title "FlÌchenfarben lÎschen" :initial-value t );;EntferneFarbe (EntferneExemplarFarbe :value-type :boolean :toggle-type :wide-toggle :title "Exemplarfarben lÎschen" :initial-value t );;EntferneExemplarFarbe (neues-Fenster :value-type :boolean :toggle-type :wide-toggle :title "in neuem Fenster darstellen" :initial-value nil );;neues-Fenster );;variables :mutual-exclusion '(check-verschieben check-exemplar) :local-functions'( (verschieben () (let () (dolist (teil-bg-einzeln teil-bg) (when check-verschieben (sd-call-cmds (change_pa_owner :new_owner Ziel-BG :parts_assemblies :START teil-bg-einzeln :SELECT_DONE );;change_pa_owner );;sd-call-cmds );;when (when check-exemplar (sd-call-cmds (create_multiple_pa :share :source Teil-BG :owner Ziel-BG );;create_multiple_pa );;sd-call-cmds );;when );;dolist (SD-SET-VARIABLE-STATUS 'Teil-BG :value nil) );;let );;verschieben ;;---------------------------------------------------------------------- (BG-erzeugen () (let () (sd-call-cmds (create_assembly :name BG-neu :owner Ziel-BG ) ) (SD-SET-VARIABLE-STATUS 'Ziel-BG :value (sd-pathname-to-obj (format nil "~A\/~A" (sd-inq-obj-pathname Ziel-BG) BG-neu))) (SD-SET-VARIABLE-STATUS 'BG-neu :value nil) );;let );;BG-erzeugen ;;---------------------------------------------------------------------- ;; ---------------------------------------------------------------------------------------------------------------------------------------------------- );;local functions :ok-action '() :cancel-action '() );;sd-defdialog ;;;;-----------------------Globale Funktionen ----------------------------------------------- (defun Objekte_im_neuen_Fenster_darstellen (Teile einpassen) (let ((vp-alt (sd-inq-current-vp)) (Ansicht_merken_1 (sd-inq-vp-camera (sd-inq-current-vp)))) (if (sd-inq-vp-exists-p "geordnet") (progn (sd-set-current-vp "geordnet") (sd-call-cmds (set_vp_drawlist "geordnet" :with-wp :vp-fit Teile update_screen))) (progn (sd-call-cmds (create_vp :name "geordnet" )) (sd-call-cmds (set_vp_drawlist "geordnet" :with-wp :vp-fit Teile update_screen))) );;if ;(sd-call-cmds (draw_only_in_new_vport Teile)) (sd-call-cmds (fit_vp "geordnet")) (sd-set-vp-camera (sd-inq-current-vp) Ansicht_merken_1 :smooth nil) (oli:sd-call-win-command-by-sysid #xE134) (sd-set-current-vp vp-alt) );;let );;Objekte_im_neuen_Fenster_darstellen ;;---------------------------------------------------------------------- ;; Funktion zum löschen ALLER Flächenfarben ausser den reservierten (defun DeleteFaceColor (3D-Objekt) (setf FacesToClear nil) ;;wenn 3D-Objekt ein Teil ist (if (sd-inq-part-p 3D-Objekt) ;;dann... (progn ;;Alle Flächen des Teils auswählen (sd-call-cmds (get_selection :focus_type *sd-face-seltype* :check_function #'SelectReserverdFaceColors :select :selected_part 3D-Objekt :all_3d) :failure (setf FacesToClear nil) :success (setf FacesToClear *SD-ACTION-RESULT*) );;sd-call-cmds (dolist (SingleFace FacesToClear) (face_prop :the_face SingleFace :COLOR :OFF );;face_prop );;dolist );;progn ;;sonst... ();;nix tun );;if );;DeleteFaceColor ;;---------------------------------------------------------------------- ;; ... das ist die >> :check_function << ;; auf reservierte Flächenfarben prüfen (defun SelectReserverdFaceColors (FaceToCheck) (if (not (or ;; wenn Farbe nicht Passung, oder nicht Gewinde, ... >>> dann wird gelÎscht! (equal (sd-inq-face-color FaceToCheck) (gpnt3d 0.50196081399917603 0.0 0.0 )) ;; Passung (equal (sd-inq-face-color FaceToCheck) (gpnt3d 0.0 0.0 0.50196081399917603 )) ;; Gewinde (equal (sd-inq-face-color FaceToCheck) (gpnt3d 0.0 1.0 0.0 )) ;; Hub (equal (sd-inq-face-color FaceToCheck) (gpnt3d 1.0 0.0 0.0 )) ;; Sicherheitsbereich (equal (sd-inq-face-color FaceToCheck) (gpnt3d 0.58039218187332153 0.58039218187332153 0.19607844948768616 )) ;; Fräsen (equal (sd-inq-face-color FaceToCheck) (gpnt3d 0.58823531866073608 0.58823531866073608 0.19607844948768616 )) ;; Fräsen (equal (sd-inq-face-color FaceToCheck) (gpnt3d 0.0 0.0 1 )) ;; Bedienelemete (equal (sd-inq-face-color FaceToCheck) (gpnt3d 0.0 0.0 1.0 )) ;; Steckanschlüsse (equal (sd-inq-face-color FaceToCheck) (gpnt3d 1.0 0.0 1.0 )) ;; Cabeling-Pins (equal (sd-inq-face-color FaceToCheck) (gpnt3d 0.89803928136825562 0.50196081399917603 0.0 )) ;; Service (equal (sd-inq-face-color FaceToCheck) (gpnt3d 0.0 1.0 1.0 )) ;; Absteckbohrungen (equal (sd-inq-face-color FaceToCheck) (gpnt3d 1.0 0.63137257099151611 0.60000002384185791 )) ;; alte "rosarote" Gewinde );;or );;not :Ok :filter );;if );;SelectReserverdFaceColors ;;---------------------------------------------------------------------- ;; Löschen der Exemplarfarbe (defun DelExCol (3D-Objekt) (if (sd-inq-part-p 3D-Objekt) (progn (part_prop :the_part 3D-Objekt :COLOR :OFF ;; Exemplarfarbe :OFF = KEINE >> setzt auch Exemplarkantenfarbe zurück!! );;part_prop );;progn );;if );;DelExCol