;;--------------------------------------------------------------------------------------------------------*
;; Modulbeschreibung:
;; Erstellt eine AE auf eine Schnittebene und projeziert Querschnitt 
;;--------------------------------------------------------------------------------------------------------*
;;  Dateiname: ae_auf_schnittebene.lsp
;;  Version  : 1.0
;;  Datum    : 18.04.2023
;;  Author   : MiBr
;;--------------------------------------------------------------------------------------------------------*

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

(sd-defdialog 'ae_auf_schnittebene
:dialog-control :sequential
:toolbox-button t
:ok-action  '(sd-call-cmds (do-it))

:local-functions
'(
(do-it ()
	(let (koord_cp origin_cp  u-dir_cp normal_cp alle_objekte falsche_aufl)
		(when (clipping-active-feats (sd-inq-current-vp))
			;;; Koordinatensystem auswerten
			(setf koord_cp (first (clipping-inq-planes (clipping-active-feats (sd-inq-current-vp)))))
			;Nullpunkt erstellen
			(setf origin_cp (first koord_cp))
			;Normale erstellen und Richtung wechseln
			(setf normal_cp  (sd-dir-rotate (second koord_cp) pi :point origin_cp :direction (third koord_cp)))
			;U-Dir erstellen und Richtung um 90° drehen
			(setf u-dir_cp  (sd-dir-rotate normal_cp (/ pi 0.75) :point origin_cp :direction (third koord_cp)))
			;Arbeitsebene erstellen
			(create_workplane	:new
								:pt_dir
								:origin origin_cp 
								:normal normal_cp
								:u_dir u-dir_cp
			)
			;alle aktiven Teile der Darstellungsliste ermitteln
			(setf alle_objekte (mibr::inq-obj-tree-list (sd-pathname-to-obj "/")))
			(setf alle_objekte (remove-if-not 'sd-inq-part-p alle_objekte))
			(setf alle_objekte (remove-if-not 'my_drawlist-member-p alle_objekte))
			(setf falsche_aufl (remove-if 'my-geo-resolution-p alle_objekte))
			(when falsche_aufl
				(setf alle_objekte (remove-if-not 'my-geo-resolution-p alle_objekte))
				(display (format nil "Achtung,~%folgende Bauteile besitzen eine geringe Auflösung und werden ignoriert!"))
				(dolist (item falsche_aufl)
					(display (format nil "Einzelteil '~a' Auflösung '~a'" (sd-inq-obj-basename item) (sd-inq-part-geo-resolution item)))
				)
			)
			;Querschnitt erstellen
			(when alle_objekte
				(cross_section 	:cross_section_wp (sd-inq-curr-wp)
								:cross_section_part alle_objekte
								:construction_geometry
								:resolver_mode :same
				)
			)
		)
	)
) ;end do-it
) ;end local-functions
) ;end sd-defdialog

(defun my_drawlist-member-p (item)
	(sd-inq-vp-drawlist-member-p (sd-inq-current-vp) item)
)

(defun my-geo-resolution-p (item)
	(equal (sd-inq-part-geo-resolution item) 0.000001)
)

(defun inq-obj-tree-list (obj)
	(cons obj
		(apply #'nconc (mapcar #'inq-obj-tree-list (sd-inq-obj-children obj)))
	)
) ;end defun