(in-package  :BFE-TOOLS)
(use-package :oli)

;; Hauptschalter
(setf *bfe-3D-COPILOT* t)

;; Performancebremse Kurventeile ignorieren
(setf  *bfe-3D-COPILOT-SKIP-SPLINES* t)



;;----------------------------------------------------------------------------------------------------------------------------------
;;     Funktion: (bfe-sd-classic-polestar-components) 																
;;		Diese Funktion wird getriggert wenn der 3D-Copilot beim dynamischen Positionieren erstellt wird.						
;; 		Wenn keine explizite geometrische Referenz ausgewählt wird, ist der 2. Listeneintrag NIL, genau dort greift diese FNC		
;;		Die Hilfs-FNC sd-inq-obj-box ist undokumentiert und könnte in einer zukünftigen Version entfallen						
;;----------------------------------------------------------------------------------------------------------------------------------
(defvar *original-SD-CLASSIC-POLESTAR-COMPONENTS* nil) ; Version 2.0
(defun bfe-sd-classic-polestar-components	(&rest args)
	(when *bfe-3D-COPILOT*
		(unless (cadr args) 
			(let (sel-item box box-pnts diag dist ref-pnt kurventeil debug debug-time)

				;; Bei Baugruppen wird geprüft ob Kurventeile vorhanden sind
				(setf sel-item (car args))
				(when sel-item (when (sd-inq-assembly-p sel-item) (setf kurventeil (sd-call-cmds (get_selection :focus_type *sd-part-seltype* :allow_wire_part :check_function #'(lambda (object) (if (sd-inq-wire-part-p object) (if (sd-call-cmds (get_selection :focus_type *sd-spline-3d-seltype* :allow_wire_part :select :in_part object)) :ok :filter) :filter)) :select :recursive :in_assembly sel-item)))))

				(if (and kurventeil *bfe-3D-COPILOT-SKIP-SPLINES*)
					(sd-display-alert (format nil "Es wurde in der gewählten Baugruppe eine Splinekurve gefunden~%Neupositionierung des 3D-Copiloten aus Performancegründen übersprungen") :icon  :info :auto-close-time 5 :desktop-relative nil)
					(progn
						(when sel-item (when (or (sd-inq-assembly-p sel-item) (sd-inq-part-p sel-item)) (unless (sd-inq-empty-part-p sel-item) (setf box (sd-inq-obj-box sel-item)))))
						(when (car box) (setf box-pnts (sd-box-points (car box) (cadr box) 0,0,1 0,1,0)))
						(when box-pnts (setf diag (sd-vec-subtract  (nth 6 box-pnts) (nth 0 box-pnts))))
						(when diag (setf dist (sd-vec-length diag)))
						(when (and box-pnts diag dist) (setf ref-pnt (sd-vec-translate (nth 0 box-pnts) diag (/ dist 2))))

						(when ref-pnt
							(setf args (list sel-item ref-pnt))
						)
					)
				)
			)
		)
	)
	(apply *original-SD-CLASSIC-POLESTAR-COMPONENTS* args)
)

(unless *original-SD-CLASSIC-POLESTAR-COMPONENTS* (setf *original-SD-CLASSIC-POLESTAR-COMPONENTS* (symbol-function (find-symbol "SD-CLASSIC-POLESTAR-COMPONENTS" (find-package "OLI")))))
(setf (symbol-function (find-symbol "SD-CLASSIC-POLESTAR-COMPONENTS" (find-package "OLI"))) (symbol-function 'bfe-sd-classic-polestar-components))