;; =======================================================================================
;; gdm_properties_abfragen.lsp
;; os / 22.08.2016 gdm-masse-abfragen-dialog
;; os / 06.09.2016 gdm-genauigkeit-abfragen-dialog
;; os / 09.09.2016 gdm-anzahl-teile-bg-abfragen-dialog
;; =======================================================================================
;; sd-defdialog 'gdm-masse-abfragen-dialog
;; =====
;; Anzeigen der Masse einer Baugruppe mit allen Unterbaugruppen und seiner Einzelteile.
;; Sortiert nach Struktur oder Gewicht
;; Liste ohne Exemplare und mit der Option Library Parts ja/nein
;; =======================================================================================
;; sd-defdialog 'gdm-genauigkeit-abfragen-dialog
;; =====
;; Anzeigen der Genauigkeit aller Einzelteile einer Baugruppe mit allen Unterbaugruppen.
;; Sortiert nach der Genauigkeit
;; Liste ohne Exemplare und mit der Option Library Parts ja/nein
;; =======================================================================================
;; =======================================================================================
;; sd-defdialog 'gdm-anzahl-teile-bg-abfragen-dialog
;; =====
;; Anzeigen der Anzahl von Parts (mit Face und Wire), Baugruppen, Container und Library
;; einer Baugruppenstruktur.
;; =======================================================================================

(in-package  :GDM)
(use-package :OLI)

(sd-defdialog 'gdm-masse-abfragen-dialog
  :dialog-title (sd-multi-lang-string "Show Weight" :german "Masse anzeigen")
  :toolbox-button t
  :variables
  '(
     (DUMMY_TITLE_1 :title (sd-multi-lang-string "from ..." :german "von ..."))
     
     (BG-Teil
          :value-type :part-assembly
          :size :third
          :modifies nil
          :initial-value nil
          :title (sd-multi-lang-string "Part/Assy" :german "Teil/BG")
          :prompt-text (sd-multi-lang-string "Specify Part or Assembly" :german "Teil oder Baugruppe angeben")
     )

     (DUMMY_TITLE_2 :title (sd-multi-lang-string "Show" :german "Anzeigen"))

     (Baum
          :value-type :boolean
          :title (sd-multi-lang-string "Assy Structure" :german   "Baugr. Struktur")
		:toggle-type :wide-toggle
     )

     (Sortiert
          :value-type :boolean
          :title (sd-multi-lang-string "Sorted by Weight" :german   "Sortiert nach Gewicht")
		:toggle-type :wide-toggle
          :initial-value t
     )
     
     (DUMMY_TITLE_3 :title (sd-multi-lang-string "List" :german "Liste"))
     
     (Mit_LibPart
          :value-type :boolean
          :title (sd-multi-lang-string "with Library Part" :german   "mit Library Part")
		:toggle-type :wide-toggle
          :initial-value t
     )
     
     (Ohne_LibPart
          :value-type :boolean
          :title (sd-multi-lang-string "without Library Part" :german   "ohne Library Part")
		:toggle-type :wide-toggle
     )
     
     ("")
     
     (Next
          :title (sd-multi-lang-string "Next" :german   "Nächstes")
		:toggle-type :wide-toggle
		:push-action (os-gewicht-abfragen)
     )
     
  );variables

  :mutual-exclusion '((Baum Sortiert) (Mit_LibPart Ohne_LibPart))
  
  :local-functions
  '(
     ;; Die Liste der Gewichtsangaben wird nach der Baumstruktur sortiert angezeigt
     (os-masse-baum ()
        (let ( (contents-list nil) (obj-list nil) (Teildichte nil) (Volumen nil) (Masse nil) (Gesamt 0) )
	     (mapcar #'(lambda (one-obj)
                         (when (not (sd-inq-empty-part-p one-obj))
                              (setf Teildichte (sd-inq-part-density one-obj))
                              (setf Volumen (sd-call-cmds (get_vol_prop :for_part :part_asmb (sd-inq-obj-pathname one-obj) :volume) :failure nil))
                              (setf Masse (* Teildichte Volumen))
                              (setf Gesamt (+ Gesamt Masse))
                              ;; show shared parts only once
                              (unless (member (elan:inq_shared_data (elan::sel_item-item one-obj)) contents-list :test #'equal)
                                   (push (elan:inq_shared_data (elan::sel_item-item one-obj)) contents-list)
                                   ;; don't add Library Parts to Liste when Ohne_LibPart = true
                                   (unless (and Ohne_LibPart (not (eq nil (first (sd-get-library-attr one-obj)))))
                                        (push (list (sd-inq-obj-pathname one-obj) Masse ) obj-list)
                                   )
                              )
                         )
		          )
		         (os-get-single-object-without BG-Teil)
		)
          (when (and obj-list (> (length obj-list) 0))
               ;; Liste Anzeigen
               (display "===========")
               (display (sd-multi-lang-string (format nil "Total Weight of / Gesamtmasse von ~a = ~,3Fg" (sd-inq-obj-pathname BG-Teil) Gesamt) ) )
               (display "with shared parts / mit Exemplare")
               (display "===========")
               (display "=== List without shared Parts / Liste ohne Exemplare ===")
               (dolist (one-list obj-list)
                    (display (sd-multi-lang-string (format nil "Weight / Masse = ~,3Fg  ~a" (second one-list) (first one-list) ) ) )
               );;dolist
               (display "=== eof ===")
               (display "")
          );;when
	  )
	)

     ;; Die Liste der Gewichtsangaben wird nach dem Gewicht sortiert angezeigt
     (os-masse-sortieren ()
        (let ( (contents-list nil) (obj-list nil) (Teildichte nil) (Volumen nil) (Masse nil) (Gesamt 0) )
	     (mapcar #'(lambda (one-obj) 
                         (when (not (sd-inq-empty-part-p one-obj))
                              (setf Teildichte (sd-inq-part-density one-obj))
                              (setf Volumen (sd-call-cmds (get_vol_prop :for_part :part_asmb (sd-inq-obj-pathname one-obj) :volume) :failure nil))
                              (setf Masse (* Teildichte Volumen))
                              (setf Gesamt (+ Gesamt Masse))
                              ;; show shared parts only once
                              (unless (member (elan:inq_shared_data (elan::sel_item-item one-obj)) contents-list :test #'equal)
                                   (push (elan:inq_shared_data (elan::sel_item-item one-obj)) contents-list)                    
                                   ;; don't add Library Parts to Liste when Ohne_LibPart = true
                                   (unless (and Ohne_LibPart (not (eq nil (first (sd-get-library-attr one-obj)))))
                                        (push (list (sd-inq-obj-pathname one-obj) Masse ) obj-list)
                                   )
                              ) 
                         )
		          )
		         (os-get-single-object-without BG-Teil)
		)
          (when (and obj-list (> (length obj-list) 0))
               ;; Liste nach Masse sortieren
               (setf obj-list (os-sort-obj-list obj-list))
               ;; Liste Anzeigen
               (display "===========")
               (display (sd-multi-lang-string (format nil "Total Weight of / Gesamtmasse von ~a = ~,3Fg" (sd-inq-obj-pathname BG-Teil) Gesamt) ) )
               (display "with shared parts / mit Exemplare")
               (display "===========")
               (display "=== List without shared Parts / Liste ohne Exemplare ===")
               (dolist (one-list obj-list)
                    (display (sd-multi-lang-string (format nil "Weight / Masse = ~,3Fg  ~a" (second one-list) (first one-list) ) ) )
               );;dolist
               (display "=== eof ===")
               (display "")
          );;when
	  );,let
	)

     ;; sorts the object list by the level as described
    (os-sort-obj-list (new_obj_list)
          (sort new_obj_list #'> :key #'second)
    )

    ;; ;; Die Liste der Gewichtsangaben wird angezeigt nach ...
    (os-gewicht-abfragen ()
          (if Baum
               (os-masse-baum)          ;; der Baumstruktur sortiert
               (os-masse-sortieren)     ;; nach Masse sortiert
          )
    )
    
  );;local-functions
    
 :ok-action '(os-gewicht-abfragen)

);;sd-defdialog


;;========================================
(sd-defdialog 'gdm-genauigkeit-abfragen-dialog
  :dialog-title (sd-multi-lang-string "Show Accuracy" :german "Genauigkeit anzeigen")
  :toolbox-button t
  :variables
  '(
     (DUMMY_TITLE_TOP :title (sd-multi-lang-string "from ..." :german "von ..."))
     (BG
          :value-type :assembly
          :modifies nil
          :initial-value nil
          :prompt-text (sd-multi-lang-string "Specify Assembly." :german "Baugruppe angeben.")
          :title (sd-multi-lang-string "Assembly" :german "Baugruppe")
     )
   
     (DUMMY_TITLE_QUALITY :title (sd-multi-lang-string "Quality" :german   "Qualität"))
     (G_GOOD
          :value-type :boolean
          :title "Good   X >= 1E-5"
          :toggle-type :wide-toggle
     )
     (G_OK
          :value-type :boolean
          :title "Ok     1E-5 < X >= 1E-4"
          :toggle-type :wide-toggle
     )
     (G_MIN
          :value-type :boolean
          :title "min    1E-4 < X >= 1E-3"
          :toggle-type :wide-toggle
     )
     (G_BAD
          :value-type :boolean
          :title "Bad    X < 1E-3"
          :toggle-type :wide-toggle
          :initial-value t
     )
     
     (DUMMY_TITLE_LIST :title (sd-multi-lang-string "List" :german   "Liste"))
     (Ohne_LibPart
          :value-type :boolean
          :title (sd-multi-lang-string "without Library Part" :german   "ohne Library Part")
		:toggle-type :wide-toggle
          :initial-value t
     )
     
     (Mit_LibPart
          :value-type :boolean
          :title (sd-multi-lang-string "with Library Part" :german   "mit Library Part")
		:toggle-type :wide-toggle
     )
     
     (NEXT
          :title (sd-multi-lang-string "Next" :german   "Nächstes")
		:toggle-type :wide-toggle
          :push-action (os-genauigkeit-abfragen)
     )
     
  );; variables
  
  :mutual-exclusion '( (G_GOOD G_OK G_MIN G_BAD) (Mit_LibPart Ohne_LibPart))
  
  :local-functions
  '(
     (os-genauigkeit-abfragen ()
        (let ( (contents-list nil) (obj-list nil) (Genauigkeit nil) )
	     (mapcar #'(lambda (one-obj) 
                         (when (not (sd-inq-empty-part-p one-obj))
                              (setf Genauigkeit (sd-inq-part-geo-resolution one-obj))
                              ;; show shared parts only once
                              (unless (member (elan:inq_shared_data (elan::sel_item-item one-obj)) contents-list :test #'equal)
                                  (push (elan:inq_shared_data (elan::sel_item-item one-obj)) contents-list)
                                  (cond 
                                    ;; "Good   X >= 1E-5"
                                    ((and G_GOOD (>=  0.00001 Genauigkeit))
                                        ;; don't add Library Parts to Liste when Ohne_LibPart = true
                                        (unless (and Ohne_LibPart (not (eq nil (first (sd-get-library-attr one-obj)))))
                                             (push (list (sd-inq-obj-pathname one-obj) Genauigkeit ) obj-list)
                                        )
                                    )
                                    ;; "Ok     1E-5 < X >= 1E-4"
                                    ((and G_OK (and (<  0.00001 Genauigkeit) (>=  0.0001 Genauigkeit)))
                                        ;; don't add Library Parts to Liste when Ohne_LibPart = true
                                        (unless (and Ohne_LibPart (not (eq nil (first (sd-get-library-attr one-obj)))))
                                             (push (list (sd-inq-obj-pathname one-obj) Genauigkeit ) obj-list)
                                        )
                                    )
                                    ;; "min    1E-4 < X >= 1E-3"
                                    ((and G_MIN (and (<  0.0001 Genauigkeit) (>=  0.001 Genauigkeit)))
                                        ;; don't add Library Parts to Liste when Ohne_LibPart = true
                                        (unless (and Ohne_LibPart (not (eq nil (first (sd-get-library-attr one-obj)))))
                                             (push (list (sd-inq-obj-pathname one-obj) Genauigkeit ) obj-list)
                                        )
                                    )
                                    ;; "Bad    X < 1E-3"
                                    ((and G_BAD (<  0.001 Genauigkeit))
                                        ;; don't add Library Parts to Liste when Ohne_LibPart = true
                                        (unless (and Ohne_LibPart (not (eq nil (first (sd-get-library-attr one-obj)))))
                                             (push (list (sd-inq-obj-pathname one-obj) Genauigkeit ) obj-list)
                                        )
                                    )
                                  );;cond
                              );;unless 
                         )
		          )
		         (os-get-single-object-without BG)
		)
          (if (and obj-list (> (length obj-list) 0))
             (progn
               ;; Liste nach Genauigkeit sortieren
               (setf obj-list (os-sort-obj-list obj-list))
               ;; Liste Anzeigen
               (display "=====================================================================================================")
               (display "=== List sortet by Accuracy without shared Parts / Liste nach Genauigkeit sortiert ohne Exemplare ===")
               (dolist (one-list obj-list)
                    (display (format nil "Accuracy / Genauigkeit = ~,,,,,,'EG:  of / von ~a" (second one-list) (first one-list)))
               );;dolist
               (display "")
               (display (format nil "Objects found / Gefundene Objekte = ~a" (length obj-list)))
               (display "=== eof ===")
               (display "")
             )
             (cond
                ( G_GOOD (display "No Parts found for - Good   X >= 1E-5"))
                ( G_OK   (display "No Parts found for - Ok     1E-5 < X >= 1E-4"))
                ( G_MIN  (display "No Parts found for - min    1E-4 < X >= 1E-3"))
                ( G_BAD  (display "No Parts found for - Bad    X < 1E-3"))
             )
          );;if
	  );,let
	)
     
     ;; sorts the object list by the level as described
     (os-sort-obj-list (new_obj_list)
          (sort new_obj_list #'> :key #'second)
     )

  )

  :ok-action '(os-genauigkeit-abfragen)  

);;sd-defdialog

;;========================================
(sd-defdialog 'gdm-anzahl-teile-bg-abfragen-dialog
  :dialog-title (sd-multi-lang-string "Count Assy/Part" :german "BG/Teile zählen")
  :toolbox-button t
  :variables
  '(
     (DUMMY_TITLE_TOP :title (sd-multi-lang-string "from ..." :german "von ..."))
     (BG
          :value-type :assembly
          :modifies nil
          :initial-value nil
          :prompt-text (sd-multi-lang-string "Specify Assembly." :german "Baugruppe angeben.")
          :title (sd-multi-lang-string "Assembly" :german "Baugruppe")
     )
     
     (NEXT
          :title (sd-multi-lang-string "Next" :german   "Nächstes")
		:toggle-type :wide-toggle
          :push-action (os-anzahl-teile-bg-abfragen)
     )
     
  );; variables
  
  :local-functions
  '(
     (os-anzahl-teile-bg-abfragen ()
        (let ( (contents-list nil) (Anzahl_BG 0) (Anzahl_CONT 0) (Anzahl_Teil 0) (Anzahl_FaceTeil 0) (Anzahl_WireTeil 0) (Anzahl_NormTeil 0))
	     (mapcar #'(lambda (one-obj) 
                         (when (not (sd-inq-empty-part-p one-obj))
                              ;; show shared parts only once
                              (unless (member (elan:inq_shared_data (elan::sel_item-item one-obj)) contents-list :test #'equal)
                                  (push (elan:inq_shared_data (elan::sel_item-item one-obj)) contents-list)
                                  (cond 
                                    ;; Baugruppe
                                    ( (and (sd-inq-assembly-p one-obj) (eq nil (first (sd-get-library-attr one-obj))))
                                        (setf  Anzahl_BG (+ Anzahl_BG 1))
                                        (when (sd-inq-container-p one-obj)
                                             (setf  Anzahl_CONT (+ Anzahl_CONT 1)) 
                                        )
                                    )
                                    ;; Teil
                                    ( (and (sd-inq-part-p one-obj) (eq nil (first (sd-get-library-attr one-obj))))
                                        (setf Anzahl_Teil (+ Anzahl_Teil 1))
                                        (cond
                                             ( (sd-inq-face-part-p one-obj) (setf Anzahl_FaceTeil (+ Anzahl_FaceTeil 1)) )
                                             ( (sd-inq-wire-part-p one-obj) (setf Anzahl_WireTeil (+ Anzahl_WireTeil 1)) )
                                        )
                                    )
                                    ;; Normteil
                                    ( (not (eq nil (first (sd-get-library-attr one-obj))))
                                        (setf Anzahl_NormTeil (+ Anzahl_NormTeil 1))
                                    )
                                  );;cond
                              );;unless 
                         );;when
		          )
		         (os-get-single-object-with-assy-without BG)
		);;mapcar

          (display "==================")
          (display "Count without Shares / Anzahl ohne Exemplare")
          (display (format nil "Assembly / Baugruppen...............= ~a" (- Anzahl_BG Anzahl_CONT)))
          (display (format nil "Container / Behälter................= ~a" Anzahl_CONT))
          (display (format nil "Parts / Teile.......................= ~a" (- Anzahl_Teil Anzahl_FaceTeil Anzahl_WireTeil)))
          (display (format nil "Face Parts / Flächenteile...........= ~a" Anzahl_FaceTeil))
          (display (format nil "Wire Parts / Drahtteile.............= ~a" Anzahl_WireTeil))
          (display (format nil "Library Parts / Bibliothek Teile....= ~a" Anzahl_NormTeil))
          (display "                                   ===========")
          (display (format nil "Total / Gesamt......................= ~a" (length contents-list)))
          (display "=== eof ===")
	  );,let
	)
  )

  :ok-action '(os-anzahl-teile-bg-abfragen)  

);;sd-defdialog

;;=======================================
;; Build list with all objects exluding view, viewset, wp, wpset, coordinate, docuplanes, assemblies
(defun os-get-single-object-without (top_object)  
  (let ( (elem_list nil) )
    (if (OR (sd-inq-assembly-p top_object) (sd-inq-part-p top_object) (sd-inq-container-p top_object) )
	   (progn
	     (setf elem_list 
		   (remove-if '(lambda (obj) (OR (sd-am-view-p obj)
                                           (sd-am-view-set-p obj)
					                  (sd-inq-workplane-p obj)
                                           (sd-inq-wpset-p obj)
					                  (sd-coord-sys-object-p obj)
                                           (sd-docuplane-p obj)
					                  (sd-docuplane-set-p obj)
                                           (sd-inq-assembly-p obj)
                                        )
                         )
		   (os-inquire-tree-list top_object)))
	        elem_list
	   )
        nil
    )
    elem_list
  );;let
);,defun 

;; Build list with all objects exluding view, viewset, wp, wpset, coordinate, docuplane, docuplansets, container
(defun os-get-single-object-with-assy-without (top_object)  
  (let ( (elem_list nil) )
    (if (OR (sd-inq-assembly-p top_object) (sd-inq-part-p top_object) (sd-inq-container-p top_object) )
	   (progn
	     (setf elem_list 
		   (remove-if '(lambda (obj) (OR (sd-am-view-p obj)
                                           (sd-am-view-set-p obj)
					                  (sd-inq-workplane-p obj)
                                           (sd-inq-wpset-p obj)
					                  (sd-coord-sys-object-p obj)
                                           (sd-docuplane-p obj)
					                  (sd-docuplane-set-p obj)
                                           ;(sd-inq-container-p obj)
                                        )
                         )
		   (os-inquire-tree-list top_object)))
	        elem_list
	   )
        nil
    )
    elem_list
  );;let
);,defun

;; Scan object tree for assemblies and parts below parts and assemblies without container
(defun os-inquire-tree-list (obj)
  (cons obj 
        (apply #'nconc (mapcar #'os-inquire-tree-list (if (OR (AND (sd-inq-assembly-p obj) (NOT (sd-inq-container-p obj)))
                                                              (AND (sd-inq-part-p obj) (NOT (sd-inq-container-p obj))))
                                                          (sd-inq-obj-children obj)
						                            nil
                                                       )
			        )
	   )
   )
);;defun
;;eof