(in-package :custom)
(use-package :oli)

(sd-defdialog 'tp_part_schwer_dia
  :dialog-title "Schwerpunkt"
  :toolbox-button nil
  :after-initialization '(progn)
  :variables
  '(
	(tp_ansicht
		:selection  (*sd-anno-view-seltype*)
		:title (sd-multi-lang-string "View" :german "Ansicht")
		:prompt-text "Ansicht für Schwerpunkt auswählen"
		:initial-value nil
		:initial-visible t
		:after-input
			(progn
				(setq tp_view_type (sd-am-view-struct-type (sd-am-inq-view tp_ansicht)))
				(if (not(or
					(string= tp_view_type "FLAT_PARTIAL")
					(string= tp_view_type "ALIGNED_SECTION")
					(string= tp_view_type "SECTION")
					(string= tp_view_type "FLAT_DETAIL")
					(string= tp_view_type "PARTIAL")
					(string= tp_view_type "DETAIL")
					))
				(progn
				
					(setq tp-recover-state (sd-set-model-checkpoint))

					(setq tp_viewset_name (sd-am-view-set-struct-name (sd-am-inq-view-set (sd-am-view-struct-view-set (sd-am-inq-view tp_ansicht)))))
					(setq tp_viewset_owner (sd-inq-obj-pathname (sd-am-view-set-struct-owner (sd-am-inq-view-set (sd-am-view-struct-view-set (sd-am-inq-view tp_ansicht))))))

					(setq tp_view_name (sd-am-view-struct-name (sd-am-inq-view tp_ansicht)))
					(setq tp_first_owner (concatenate 'string "/" (sd-am-inq-curr-sheet-name) "/TP-Schwerpunkt"))

					(setq tp_first_view tp_ansicht)
					(setq tp_dir (sd-am-view-struct-dir (sd-am-inq-view tp_ansicht)))

					(setq tp_unique (sd-am-inq-unique-name tp_ansicht))
					(setq tp_parts_of_view1 (sd-execute-annotator-function :fnc (format nil "Docu_inq_all_part_paths '~A'" tp_unique)))

					(setq tp_all_part3d_list '())
					(setq tp_parts_3d (sd-am-view-struct-parts-3d (sd-am-inq-view tp_ansicht)))
					(loop for x from 0 to (-(length tp_parts_3d)1) do
					(progn
						(if (sd-inq-part-p (nth x tp_parts_3d)) (push (sd-inq-obj-pathname (nth x tp_parts_3d)) tp_all_part3d_list))
					));;ende loop

					(setq tp_part3d_list '())
					(loop for x from 0 to (-(length tp_parts_of_view1)1) do
					(progn
						(setq tp_tmp_path (nth x tp_parts_of_view1))
						(loop for y from 0 to (-(length tp_all_part3d_list)1) do
						(progn
							(if (search tp_tmp_path (nth y tp_all_part3d_list))
							(progn
								(setq tp_ges_len1 (length (nth y tp_all_part3d_list)))
								(setq tp_len1 (+ (search tp_tmp_path (nth y tp_all_part3d_list)) (length tp_tmp_path)))
								(if (= tp_ges_len1 tp_len1)
								(progn
									(push (sd-pathname-to-obj (nth y tp_all_part3d_list)) tp_part3d_list)
									(setq tp_all_part3d_list (remove-nth y tp_all_part3d_list))
									(return)
								));;ende if
							));;ende if
						));;ende loop y
					));;ende loop x
			
					(setq tp_path (concatenate 'string tp_viewset_owner "/"))
				
					(setq tp_schw_pkt1 (sd-call-cmds (get_vol_prop
						:for_part tp_part3d_list
						:centroid
					)))
					(sd-call-cmds (create_container
						:name "TP-Schwerpunkt"
						:owner tp_path
					))
					(sd-call-cmds (create_workplane :new :owner tp_path :pt_dir :origin tp_schw_pkt1 :normal tp_dir))
					(sd-call-cmds (geometry_mode :real))
					(sd-call-cmds (arc :CENTER
						(make-gpnt2d :x 0 :y 0)
						(make-gpnt2d :x 0 :y 100)
						(make-gpnt2d :x 0 :y -100)
					))
					(sd-call-cmds (line :TWO_POINTS
						(make-gpnt2d :x 0 :y 100)
						(make-gpnt2d :x 0 :y -100)
					))
					(sd-call-cmds (turn
						:part (concatenate 'string tp_path "/TP-Schwerpunkt/" "tp_sw_kugel")
						:sd-inq-curr-wp
						:rotation_angle (* 2 pi) 
						:axis :v
						:keep_profile :no
						:keep_wp :no
					))
					(sd-call-cmds (manage_parts
						:this_view tp_ansicht
						:add_selected_parts (concatenate 'string tp_path "/TP-Schwerpunkt/tp_sw_kugel")
					))
					(sd-call-cmds (am_view_prop
						:the_view tp_ansicht
						:calc_mode :classic
						:rem_small_parts :off
						:rem_3d_lib_parts :off
						:rem_full_circles :off
						:show_all_hidden_lines
						:update_view
					))
					(setq tp_ansicht nil)
					(setq alle_ansichten (sd-call-cmds (get_selection :focus_type  *sd-anno-view-seltype* :select :by_sheet_docu_rest (sd-am-inq-curr-sheet))))
					(loop for x from 0 to (-(length alle_ansichten)1) do
					(progn
						(if (string= tp_view_name (sd-am-view-struct-name (sd-am-inq-view (nth x alle_ansichten))))
						(progn
							(setq tp_ansicht (nth x alle_ansichten))
						));;ende if
					));;ende loop
					(setq tp_alle_arcs (sd-call-cmds (get_selection :focus_type *sd-anno-arc-seltype* :select :by_view_docu_rest tp_ansicht)))
					(setq tp_part nil)

					(loop for x from 0 to (-(length tp_alle_arcs)1) do
					(progn
						(setq tp_part_name
							(sd-execute-annotator-function :fnc
								(format nil "~a ~a ~a ~a ~a ~a ~a"
									"INQ_PART"
									(sd-get-annotator-position  :object (nth x tp_alle_arcs))
									"let pid (STR (INQ 301))"
									"let pid_s (DOCU_CSTRING_TO_LSTRING pid)"
									"(DOCU_OPEN_CONNECTION_TO_SD)"
									"(DOCU_ADD_LINE_TO_SD pid_s)"
									"(DOCU_CLOSE_CONNECTION_TO_SD)"
								)
							)
						);;edne setq
						(if (string= tp_part_name "tp_sw_kugel")
						(progn
							(setq tp_part (nth x tp_alle_arcs))
							(return)
						));ende if
					));ende loop

					(setq tp_cnt_pnt nil)
					(if tp_part
					(progn
						(setq tp_cnt_pnt (sd-am-arc-struct-center (sd-am-inq-specific-geo-props tp_part)))
					)
					(progn
						(display "Schwerpunkt ist nicht sichtbar in dieser Ansicht")
					));;ende if
					(sd-return-to-model-checkpoint tp-recover-state)
					(if tp_cnt_pnt
						(progn (tp_zeichne_swpkt))
						(progn (setq tp_ansicht nil))
					);;ende if
				)
				(progn
					(setq tp_ansicht nil)
					(display "Ansicht darf kein Schnitt, Ausbruch, Detail oder unterbrochene Ansicht sein !!!")
				));;ende if
			);;ende progn
	)
	(tp_groesse
		:title "Größe"
		:value-type :scale
		:minimum 1
		:maximum 100
		:initial-value 50
		:after-input
			(progn
				(setf tp_fakt (* tp_groesse 5))
				(sd-call-cmds (am_sketch_prop
					:sketch tp_first_owner
					:size_proportional :off
					:ABS_WIDTH tp_groesse
					:ABS_HEIGHT tp_groesse
				))
			);;ende progn
		:initial-enable t
	)

);; end variables
:cancel-action '(progn
					(setf alle_skizzen nil)
					(setf alle_skizzen (sd-am-inq-all-sketches (sd-am-inq-curr-sheet)))
					(dolist (skizzen alle_skizzen)
						(when (sd-string-match-pattern-p "TP-Schwerpunkt" (sd-am-inq-name skizzen))
							(sd-call-cmds (am_sketch_delete tp_first_owner :yes))
						)
					);;ende dolist
		);;ende progn
:ok-action '(progn
				(if tp_cnt_pnt (tp_ordne_besitzer_zu))
			);;ende progn
:local-functions '(

(tp_zeichne_swpkt ()
	(sd-am-create-sketch :name "TP-Schwerpunkt" :position tp_cnt_pnt :owner_type :current-sheet)

	(setq tp_cnt_p1x (gpnt2d_x tp_cnt_pnt))
	(setq tp_cnt_p1y (gpnt2d_y tp_cnt_pnt))
	
	(setq docu::*docu-hide-wrong-owner-warning* t) ;Schaltet Warnmeldung aus
	(sd-call-cmds (AM_GEO_LINE_2POS :owner tp_first_owner
		(make-gpnt2d 	:x (- tp_cnt_p1x 25) :y tp_cnt_p1y)
		(make-gpnt2d 	:x (+ tp_cnt_p1x 25) :y tp_cnt_p1y)
	))
	(sd-call-cmds (AM_GEO_LINE_2POS :owner tp_first_owner
		(make-gpnt2d 	:x tp_cnt_p1x :y (- tp_cnt_p1y 25))
		(make-gpnt2d 	:x tp_cnt_p1x :y (+ tp_cnt_p1y 25))
	))
	(sd-call-cmds (am_geo_arc_center
		:owner tp_first_owner
		(make-gpnt2d :x tp_cnt_p1x :y tp_cnt_p1y)
		(make-gpnt2d :x tp_cnt_p1x :y (+ tp_cnt_p1y 25))
		(make-gpnt2d :x (- tp_cnt_p1x 25) :y tp_cnt_p1y)
	))
	(sd-call-cmds (am_geo_arc_center
		:owner tp_first_owner
		(make-gpnt2d :x tp_cnt_p1x :y tp_cnt_p1y)
		(make-gpnt2d :x tp_cnt_p1x :y (- tp_cnt_p1y 25))
		(make-gpnt2d :x (+ tp_cnt_p1x 25) :y tp_cnt_p1y)
	))
	
	(setq tp_a (* (sin (sd-deg-to-rad 45)) 25))
	(sd-call-cmds (am_man_hatch
		:owner tp_first_owner
		(make-gpnt2d 	:x (- tp_cnt_p1x 25) :y tp_cnt_p1y)
		(make-gpnt2d 	:x tp_cnt_p1x :y tp_cnt_p1y)
		(make-gpnt2d 	:x tp_cnt_p1x :y (+ tp_cnt_p1y 25))
		(make-gpnt2d 	:x (- tp_cnt_p1x tp_a) :y (+ tp_cnt_p1y tp_a))
	))
	(sd-call-cmds (am_man_hatch
		:owner tp_first_owner
		(make-gpnt2d 	:x (+ tp_cnt_p1x 25) :y tp_cnt_p1y)
		(make-gpnt2d 	:x tp_cnt_p1x :y tp_cnt_p1y)
		(make-gpnt2d 	:x tp_cnt_p1x :y (- tp_cnt_p1y 25))
		(make-gpnt2d 	:x (+ tp_cnt_p1x tp_a) :y (- tp_cnt_p1y tp_a))
	))
	(setq all_hatch (sd-call-cmds (get_selection :focus_type  *sd-anno-face-seltype* :select :by_sketch_docu_rest tp_first_owner)))

	(sd-call-cmds (am_hatch_modify
		:HATCH_LIST all_hatch
		:pattern_dist 0
	))
	(sd-call-cmds (am_geo_circle_diameter
		:owner tp_first_owner
		(make-gpnt2d :x (- tp_cnt_p1x 25) :y tp_cnt_p1y)
		(make-gpnt2d :x (+ tp_cnt_p1x 25) :y tp_cnt_p1y)
	))
	(setq docu::*docu-hide-wrong-owner-warning* nil) ;Schaltet Warnmeldung aus				
);;ende tp_zeichne_swpkt

(tp_ordne_besitzer_zu ()
	(setq all_geo (sd-call-cmds (get_selection :focus_type *sd-anno-geo-seltype* :select :by_sketch_docu_rest tp_first_owner)))
	(setq tp_obj_list '())
	(loop for x from 0 to (-(length all_geo)1) do
	(progn
		(if (not (gpnt2d-p(sd-am-inq-specific-geo-props (nth x all_geo))))
		(progn
			(push (nth x all_geo) tp_obj_list)
		));;ende if
	));;ende loop
	(sd-call-cmds (am_move
		:sel_list tp_obj_list
		:show_owner
		:owner_view tp_first_view
		:same_pos
	))
	(sd-call-cmds (AM_SKETCH_DELETE :sketch "1/TP-Schwerpunkt" :YES))
);;ende tp_ordne_besitzer_zu


);;ende local-functions

);;ende dialog
(defun remove-nth (n list)
  (declare
    (type (integer 0) n)
    (type list list))
  (if (or (zerop n) (null list))
    (cdr list)
    (cons (car list) (remove-nth (1- n) (cdr list)))))