;;----------------------------------------------------------------------------*
;; Modulbeschreibung:
;; Auswahl gleicher Kanten, Flächen, Teile, Baugruppen
;;----------------------------------------------------------------------------*
;;  Dateiname: 			gleiche_kanten_flaechen_multi.lsp
;;  Version  : 			1.0
;;  Datum    : 			23.01.2024
;;  Author   :	 			MiBr
;;  Beschreibung: 			Wählt gleiche Kanten, Flächen, Teile, Baugruppen
;;----------------------------------------------------------------------------*

(in-package :mibr)
(use-package ':oli)

(sd-defdialog 'gleiche_kanten_flaechen
:dialog-title "Kante/Fläche wählen"
:dialog-type :interrupt
:without-show t
:prompt-variable 'auswahl_ka_fl
:variables '(
(auswahl_ka_fl	:selection (*sd-edge-3d-seltype* *sd-face-seltype* *sd-part-seltype* *sd-assembly-seltype*)
				:title "Referenz Kante/Fläche"
				:prompt-text "Referenz Kante/Fläche auswählen"
				:multiple-items t
				:initial-visible nil
				:after-input (do-it)
				:next-variable (sd-accept-dialog)
)
(gewaehlte_ka_fl_prt_bg)
)
:ok-action '(sd-call-cmds (waehle_ka_fl gewaehlte_ka_fl_prt_bg))
:local-functions '(
(do-it ()
	(let (check_ein_teil alle_fl alle_ka ref_ka_fl pseudo_nr_list auswahl_fl auswahl_ka redu_auswahl_ka redu_auswahl_fl teil_ermit auswahl_prt teile_liste auswahl_bg)

		(dolist (item  auswahl_ka_fl)
			(unless (or (sd-inq-part-p item) (sd-inq-assembly-p item)) (push (sd-inq-parent-obj item) check_ein_teil))
		)
		(setf check_ein_teil (remove-duplicates check_ein_teil :test #'equal :key #'sd-inq-obj-contents-sysid)) ;Entfernt Exemplar von Teilen zum Vergleichen
		(if (<=  (length check_ein_teil) 1) ;Es darf nur ein Bauteil gewählt sein!
			(progn	(setf gewaehlte_ka_fl_prt_bg nil) ;Ausgewählte Kanten/Flächen nullen
					(setf teil_ermit (first check_ein_teil)) ;Exemplar bestimmen
					;;; Flächen, Kanten und Teile in Listen trennen
					(dolist (item auswahl_ka_fl) ;Fläche, Kante oder Teil ermitteln und einsortieren
						(cond	((oli::is-edge-p item) (push item auswahl_ka))
								((oli::is-face-p item) (push item auswahl_fl))
								((sd-inq-part-p item) (push item auswahl_prt))	
								((sd-inq-assembly-p item) (push item auswahl_bg))
						)
					)
			;;; Flächen ;;;
					;Gleich große Flächen entfernen
					(when auswahl_fl
						(setf pseudo_nr_list nil)
						(dolist (groesse auswahl_fl)
							(unless (find (sd-call-cmds (get_vol_prop :for_face groesse :area))
									pseudo_nr_list
									:test #'(lambda(p vs) (and (< (- p 0.01) vs) (> (+ p 0.01) vs))))
										(push (sd-call-cmds (get_vol_prop :for_face groesse :area)) pseudo_nr_list)
										(push groesse redu_auswahl_fl)
							)
						)
						;Alle Flächen im Teil wählen
						(setf alle_fl (sd-call-cmds (get_selection 	:focus_type *sd-face-seltype*
																	:select
																	:in_part teil_ermit)))
						;Gleiche Flächen im Teil suchen und hinzufügen
						(dolist (item_fl redu_auswahl_fl)
							(setf ref_ka_fl (sd-call-cmds (get_vol_prop :for_face item_fl :area)))
							(dolist (item (mibr::suche_die_flaechen ref_ka_fl alle_fl 0.01)) ;defun aus Kanten-Lisp
								(push item gewaehlte_ka_fl_prt_bg)
							)
						)
					)
			;;; Kanten ;;;					
					;Gleich lange Kanten entfernen
					(when auswahl_ka		
						(setf pseudo_nr_list nil)
						(dolist (laenge auswahl_ka)
							(unless (find (sd-call-cmds (measure_dist :edge_length laenge))
									pseudo_nr_list
									:test #'(lambda(p vs) (and (< (- p 0.001) vs) (> (+ p 0.001) vs))))
										(push (sd-call-cmds (measure_dist :edge_length laenge)) pseudo_nr_list)
										(push laenge redu_auswahl_ka)
							)
						)
						;Alle Kanten im Teil wählen
						(setf alle_ka (sd-call-cmds (get_selection 	:focus_type *sd-edge-3d-seltype*
																	:select
																	:in_part teil_ermit)))
						;Gleiche Kanten im Teil suchen und hinzufügen
						(dolist (item_ka redu_auswahl_ka)
							(setf ref_ka_fl (sd-call-cmds (measure_dist :edge_length item_ka)))
							(dolist (item (mibr::suche_die_kanten ref_ka_fl alle_ka 0.001)) ;defun aus Kanten-Lisp
								(push item gewaehlte_ka_fl_prt_bg)
							)
						)
					)
					
					;Entfernt Exemplar von Flächen/Kanten
					(when gewaehlte_ka_fl_prt_bg (setf gewaehlte_ka_fl_prt_bg (remove-duplicates gewaehlte_ka_fl_prt_bg :test #'equal)))
					
			;;; Teile ;;;
					; Gleiche Teile in Baugruppe
					(when auswahl_prt
						(setf auswahl_prt (remove-duplicates auswahl_prt :test #'equal :key #'sd-inq-obj-contents-sysid)) ;Entfernt Exemplar von Teilen
						(dolist (item_prt auswahl_prt)
							(if (sd-inq-parent-obj item_prt)
								(setf teile_liste (sd-inq-obj-children (sd-inq-parent-obj item_prt)))
								(setf teile_liste (sd-inq-obj-children (sd-pathname-to-obj "/")))
							)
							(dolist (item teile_liste)
								(when (equal (sd-inq-obj-contents-sysid item_prt) (sd-inq-obj-contents-sysid item))
									(push item gewaehlte_ka_fl_prt_bg)
								)
							)
						)
					)
			;;; Baugruppen ;;;
					; Gleiche Baugruppen in Baugruppe
					(when auswahl_bg
						(setf auswahl_bg (remove-duplicates auswahl_bg :test #'equal :key #'sd-inq-obj-contents-sysid)) ;Entfernt Exemplar von Teilen
						(dolist (item_bg auswahl_bg)
							(if (sd-inq-parent-obj item_bg)
								(setf teile_liste (sd-inq-obj-children (sd-inq-parent-obj item_bg)))
								(setf teile_liste (sd-inq-obj-children (sd-pathname-to-obj "/")))
							)
							(dolist (item teile_liste)
								(when (equal (sd-inq-obj-contents-sysid item_bg) (sd-inq-obj-contents-sysid item))
									(push item gewaehlte_ka_fl_prt_bg)
								)
							)
						)
					)
			) ;end progn
			(sd-display-message (format nil "Kanten/Flächen nicht von einem Teil!"))
		)
	) ;end let
) ;end do-it
) ;end local-functions
) ;end sd-defdialog

(defun waehle_ka_fl (gewaehlte_ka_fl_prt_bg)
	(setf mibr::ka_fl_liste_gewaehlt gewaehlte_ka_fl_prt_bg)
	(sd-put-buffer "mibr::ka_fl_liste_gewaehlt")
)