;;-----------------------------------------------------------------------------
;;                                      for PTC Creo Elements/Direct Modeling
;;                                       better known as CoCreate SolidDesigner
;;  Description:
;;      create a "revision cloud" as a grahical hint to point viewers 
;;          to most recent changes in the drawing
;;          * select an owner (view / sketch)
;;          * drawing the cloud with arcs, finish automatically
;;
;;-----------------------------------------------------------------------------
;;
;;  Filename   : tp_rev_wolke.lsp
;;  Version    : 1.0
;;  Datum      : 05dec2017
;;  Author     : taino@forum@cad.de
;;  Download   : http://osd.cad.de/lisp_2d_24.htm
;;  SD-Version : developed with 19.00  - might be compatible with 15.x, too
;;  Reference  : http://ww3.cad.de/foren/ubb/Forum29/HTML/004550.shtml
;;
;;  translated : german/english by der_Wolfgang@forum@Cad.de  06.12.2017
;;-----------------------------------------------------------------------------

(in-package :custom)
(use-package :OLI)
(use-package :docu)

(sd-defdialog 'tp_am_rev_wolke
  :dialog-title '(sd-multi-lang-string "Revision Cloud" :german "Rev.Wolke")
  :after-initialization '(progn
		(sd-freeze-setting-value)
		(setf tp_line_stil (sd-get-setting-value "Annotation/Geometry/Standard"))
		(sd-set-setting-value "Annotation/General/LineStyle/Ltype" :style tp_line_stil :value tp_linien)
		(sd-set-setting-value "Annotation/General/LineStyle/Color" :style tp_line_stil :value tp_farbe)
		(setq cloudFinished nil)
	)
  :toolbox-button nil
  :variables
  '(
	(tp_revWolkeBaseName
		:initial-value  "revWolke"
	)
	(tp_revWolkePath
		:initial-value (concatenate 'string "/" (sd-am-inq-curr-sheet-name) "/" (sd-am-inq-name tp_ansicht) "/" tp_revWolkeBaseName)
	)
	("Besitzer")
	(tp_ansicht
		:selection  (*sd-anno-view-seltype* *sd-anno-sketch-seltype*)
		:title (sd-multi-lang-string "View/Sketch" :german "Ansicht/Skizze")
		:prompt-text (sd-multi-lang-string "Select view or sketch as owner." :german "Ansicht wählen")
		:initial-visible t
		:after-input
			(progn
;;Anfang tp_revWolkeBaseName wird erstellt 
				(setf tp_bol T)
				(setf tp_bol1 nil)
				(setf alle_skizzen nil)
				(setf alle_skizzen (sd-am-inq-all-sketches tp_ansicht))
				(loop for x from 1 to 100 do
				(progn
					(setf tp_check_name (concatenate 'string tp_revWolkeBaseName "." (sd-num-to-string x)))
					(loop for y from 0 to (-(length alle_skizzen)1) do
					(progn
						(if (string= tp_check_name (sd-am-inq-name (nth y alle_skizzen)))
						(progn
							(setf tp_bol nil)
							(return)
						));;ende if
					));;ende loop
					(if tp_bol
					(progn
						(setf tp_revWolkeBaseName tp_check_name)
						(setf tp_revWolkePath(concatenate 'string "/" (sd-am-inq-curr-sheet-name) "/" (sd-am-inq-name tp_ansicht) "/" tp_revWolkeBaseName))
						(return)
					));;ende if
					(setf tp_bol t)
				));;ende loop
;;Ende tp_revWolkeBaseName wird erstellt 
				(if (sd-am-sketch-p tp_ansicht) (setf tp_type :sketch))
				(if (sd-am-view-p tp_ansicht) (setf tp_type :2dview))

			);;ende progn
	)
	(tp_linien
		:title (sd-multi-lang-string "Line Type" :german "Linienart")
		:range (
			(:SOLID :pixmap-name "SOLID")
			(:DASHED :pixmap-name "DASHED")
			(:LONG_DASHED :pixmap-name "LONG_DASHED")
			(:DOT_CENTER :pixmap-name "DOT_CENTER")
			(:DASH_CENTER :pixmap-name "DASH_CENTER")
			(:PHANTOM :pixmap-name "PHANTOM")
			(:CENTER_DASH_DASH :pixmap-name "CENTER_DASH_DASH")
			(:DOTTED :pixmap-name "DOTTED")
		)
		:after-input
			(progn
				(sd-set-setting-value "Annotation/General/LineStyle/Ltype" :style tp_line_stil :value tp_linien)
			);;ende progn
		:initial-value :SOLID
	)
 	(tp_size
		:title (sd-multi-lang-string "Line Size" :german "Linienstärke")
		:value-type :length
		:initial-value 0
		:check-function #'docu::check-if-greater-equal-zero
		:after-input
			(progn
				(sd-set-setting-value "Annotation/General/LineStyle/Pensize" :style tp_line_stil :value tp_size)
			);;ende progn
	)
 	(tp_farbe
		:title (sd-multi-lang-string "Line Color" :german "Farbe")
		:value-type :rgb-color
		:initial-value 16777215 ;;grau
		:after-input
			(progn
				(sd-set-setting-value "Annotation/General/LineStyle/Color" :style tp_line_stil :value tp_farbe)
			);;ende progn
	)
	(tp_start_pnt
		:value-type :docupntcnp
		:initial-visible t
		:prompt-text (sd-multi-lang-string "Specify point to start." :german "Punkt angeben")
		:title (sd-multi-lang-string "Start Point" :german "1.Punkt")
		:after-input
			(progn
				(if tp_bol1 nil
				(progn
					(if (sd-am-sketch-p tp_ansicht)
					(progn 
						(sd-am-create-sketch :name tp_revWolkeBaseName :position tp_start_pnt :owner_type :sketch :owner tp_ansicht)
						(setf tp_obj_1 (sd-call-cmds (get_selection :FOCUS_TYPE *sd-anno-sketch-seltype* :SELECT :BY_SKETCH_DOCU_REST tp_ansicht)))
						(dolist (skizze tp_obj_1)
							(when (sd-string-match-pattern-p tp_revWolkeBaseName (sd-am-inq-name skizze))
								(setf tp_sk_owner skizze)
						))
					));;ende if
					(if (sd-am-view-p tp_ansicht)
					(progn
						(sd-am-create-sketch :name tp_revWolkeBaseName :position tp_start_pnt :owner_type :2dview :owner tp_ansicht)
						(setf tp_sk_owner tp_revWolkePath)
					))
					(setf tp_first_pnt tp_start_pnt)
					(setf tp_bol1 t)
				));;ende if

				(sd-execute-annotator-command :cmd
								(format nil "ARC DIAMETER ~A,~A"
										(oli::gpntdocu_x tp_start_pnt)
										(oli::gpntdocu_y tp_start_pnt)))
			)
			:next-variable 'tp_end_pnt
    )
	(tp_end_pnt
		:value-type :docupntcnp
		:prompt-text (sd-multi-lang-string "Specify next point" :german "Punkt angeben")
		:title (sd-multi-lang-string "Next Point" :german "2.Punkt")
		:after-input
			(progn
				(sd-call-cmds (AM_GEO_ARC_DIAMETER :owner tp_sk_owner tp_start_pnt tp_end_pnt))

				(if (and (sd-num-equal-p (oli::gpntdocu_x tp_first_pnt) (oli::gpntdocu_x tp_end_pnt))
						(sd-num-equal-p (oli::gpntdocu_y tp_first_pnt) (oli::gpntdocu_y tp_end_pnt)))
				(progn
					(sd-execute-annotator-command :cmd "END")
					(sd-unfreeze-setting-value)
					(setq cloudFinished T)
				)
				(progn
					(setq tp_start_pnt tp_end_pnt)
					(sd-execute-annotator-command :cmd
					(format nil "ARC DIAMETER ~A,~A"
						(oli::gpntdocu_x tp_start_pnt)
						(oli::gpntdocu_y tp_start_pnt))
					)
					(setq tp_end_pnt nil)
				));;ende if
			);;ende progn
		:next-variable (if cloudFinished (sd-accept-dialog) 'tp_end_pnt)
	)
	("created by t. peter")
) ;; end variables

:cancel-action '(progn (exit-strategie))
:cleanup-action '(progn (if cloudFinished nil (exit-strategie)))

:local-functions '(
	(exit-strategie ()
		(sd-execute-annotator-command :cmd "END")
		(setf alle_skizzen nil)
		(setf alle_skizzen (sd-am-inq-all-sketches tp_ansicht))
		(dolist (skizze alle_skizzen)
		(when (sd-string-match-pattern-p tp_revWolkeBaseName (sd-am-inq-name skizze))
				(sd-call-cmds (AM_SKETCH_DELETE :sketch tp_revWolkePath :yes))
		))
		(sd-unfreeze-setting-value)
	);;ende exit-strategie
) ;; end local functions
) ;; end dialog