#| created: 2009-01-22 last modified: 2009-01-25 version: 2.01 Author: Patrick Weber for: ThE CaD.De-CoMmUnItY tested with: OneSpace Modeling 14.00B - 15.50C Saves "All at Top" in a package (.pkg) AND creates a thumbnail in JPEG format in the same folder. Background is customizable. Search for "create_vp". Speichert "Alles von Top" in einem Paket (.pkg) UND erstellt ein Vorschaubild im JPEG-Format im selben Verzeichnis. Hintergrundfarbe ist anpassbar. Suche im Code nach "create_vp". |# (in-package :custom) (use-package :OLI) (sd-defdialog 'save-all-at-top-pkg-plus-picture-dialog :dialog-title "Save All At Top PKG+JPG" :variables '( (FILE :value-type :filename :direction :output :if-exist :confirm-overwrite :initialdirectory (sd-get-current-working-directory) :filetype :package :initialPattern "*.pkg" :filename-incl-path t :title "PKG-File" ) ("picture settings") (KEEP_VP_SETTINGS :value-type :boolean :title "keep viewport camera and drawlist" :toggle-type :wide-toggle :initial-value t ;t, nil ; If you change something here, you will have to change ALL_PARTS too. ) (ALL_PARTS :value-type :boolean :title "isometric view (XY-Z), all parts" :toggle-type :wide-toggle :initial-value nil ;nil, t ; If you change something here, you will have to change KEEP_VP_SETTINGS too. ) (WP :value-type :boolean :title "hide workplanes" :toggle-type :wide-toggle :initial-value nil ;nil, t ) (XSIZE :value-type :integer :title "width:" :initial-value 800 ) (YSIZE :value-type :integer :title "height:" :initial-value 600 ) ) :mutual-exclusion '(ALL_PARTS KEEP_VP_SETTINGS) :local-functions '( (save-all-at-top-pkg-plus-picture () (let (PIC_FULL_FILENAME ORG_VP_CAM ORG_VP ORG_VP_MAX PIC_VP) (when KEEP_VP_SETTINGS (setf ORG_VP_CAM (sd-inq-vp-camera (sd-inq-current-vp)) ;if KEEP_VP_SETTINGS is true -> set variable ORG_VP_CAM as SD-VP-CAMERA-STRUCT ORG_VP (sd-inq-current-vp)) ;inquire name of the "old" viewport ) ;end: when (create_vp) ;creates new viewport with standard background, add :background_color "#FFFFFF" for white background or :background_color "#000000" for black background (setf PIC_VP (sd-inq-current-vp)) ;inquires the name of the new viewport (if ALL_PARTS (progn (uic_draw_all PIC_VP) ;enables all objects in struct browser (when WP (remove_from_vp_drawlist PIC_VP (sd-call-cmds (get_selection :focus_type *sd-workplane-seltype* :select :all_at_top)))) ;if WP is true -> hide all workplanes (set_vp_direction PIC_VP (make-gpnt3d :x 1.0 :y 1.0 :z -1.0)) ;set isometric view (fit_vp PIC_VP) ;fit parts in viewport ) (progn (copy_vp_drawlist PIC_VP ORG_VP) ;copies the drawlist of the active viewport to the new one (when WP (remove_from_vp_drawlist PIC_VP (sd-call-cmds (get_selection :focus_type *sd-workplane-seltype* :select :all_at_top)))) ;if WP is true -> hide all workplanes (update_screen) (sd-set-vp-camera PIC_VP ORG_VP_CAM :smooth nil) ;set the kept camera setting ) ) ;end: if (setf PIC_FULL_FILENAME (format nil "~a.jpg" (subseq (first FILE) 0 (- (length (first FILE)) 4)))) ;substitute .pkg with .jpg (when (sd-search-file PIC_FULL_FILENAME) (delete-file PIC_FULL_FILENAME));if filename exists -> delete (create_thumbnail :vp PIC_VP :size :user :size_x XSIZE :size_y YSIZE :fit :off :filename PIC_FULL_FILENAME) ;creates picture (delete_vp PIC_VP) ;delete picture viewport (sd-maximize-vp (sd-inq-current-vp)) ;maximize "old" viewport window ---- remove if not wanted (save_package :all_at_top :overwrite :filename (first FILE) :overwrite) ;save all at top as package ) ) ;end: save-all-at-top-pkg-plus-picture ) ;end: local-functions :ok-action '(save-all-at-top-pkg-plus-picture) :help-action '(sd-display-message (format nil "~%~%created: 2009-01-22~%last modified: 2009-01-25~%version: 2.01~%Author: Patrick Weber~%for: ThE CaD-CoMmUnItY~%~%Saves \"All at Top\" in a package (.pkg) AND create a thumbnail in JPEG format in the same folder.~%~%Speichert \"Alles von Top\" in einem Paket (.pkg) UND erstellt ein Vorschaubild im JPEG-Format im selben Verzeichnis.~%") ) ;end: help-action )