;;----------------------------------------------------------------------------*
;; 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
;;----------------------------------------------------------------------------*
;; Update
;; 1.01	 Verbesserte Performance dank 'Der_Wolfgang' 24.01.2024
;; 
;;----------------------------------------------------------------------------*
(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 '(when gewaehlte_ka_fl_prt_bg
				(sd-display-alert (format nil "~a Elemente gewählt" (length gewaehlte_ka_fl_prt_bg)) :icon :info :auto-close-time 3)
				(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_prt))
						)
					)
			;;; Flächen ;;;
					;Gleich große Flächen entfernen
					(when auswahl_fl
						(setf pseudo_nr_list nil)
						(dolist (groesse auswahl_fl)
							(setq this-area  (sd-call-cmds (get_vol_prop :for_face groesse :area)))
							(unless (find this-area
									pseudo_nr_list
									:test #'(lambda(a1 a2) (< (abs (- a1 a2)) 0.01)))
										(push this-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)))
							(setq gewaehlte_ka_fl_prt_bg (nconc gewaehlte_ka_fl_prt_bg (suche_die_flaechen ref_ka_fl alle_fl 0.01)))
						)
					)
			;;; Kanten ;;;					
					;Gleich lange Kanten entfernen
					(when auswahl_ka		
						(setf pseudo_nr_list nil)
						(dolist (laenge auswahl_ka)
							(setq this-length (sd-call-cmds (measure_dist :edge_length laenge)))
							(unless (find this-length
										pseudo_nr_list
										:test #'(lambda(a1 a2) (< (abs (- a1 a2)) 0.001)))
											(push this-length 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)))
							(setq gewaehlte_ka_fl_prt_bg (nconc gewaehlte_ka_fl_prt_bg (suche_die_kanten ref_ka_fl alle_ka 0.001)))
							
						)
					)
					
					;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/Baugruppen ;;;
					(when auswahl_prt
						(setf auswahl_prt (remove-duplicates auswahl_prt :test #'equal :key #'sd-inq-obj-contents-sysid)) ;Entfernt Exemplar von Teilen/BG
						(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)
								)
							)
						)
					)
			)
			(sd-display-alert "Kanten/Flächen nicht von einem Teil!" :icon :warning :auto-close-time 5)
		)
	) ;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")
)

(defun suche_die_kanten (k_laenge gew_kanten tol_mm)
	(let (istlang die_kanten)
		(dolist (i gew_kanten)
			(setf istlang (sd-call-cmds (measure_dist :edge_length i)))
			(when (< (abs (- istlang k_laenge)) tol_mm)
				(push i die_kanten))
		) ;end dolist
	die_kanten
	)
)

(defun suche_die_flaechen (r_flaeche gew_flaechen tol_qmm)
	(let (istgross die_flaechen)
		(dolist (i gew_flaechen)
			(setf istgross (sd-call-cmds (get_vol_prop :for_face i :area )))
			(when (< (abs (- istgross r_flaeche)) tol_qmm)
				(push i die_flaechen))
		) ;end dolist
	die_flaechen
	)
)