#|
###########################################
#			Koordinatentabelle						#
###########################################
#	erstellt:		#	24.09.2007					#
#	Ersteller:		#	R.Witt						#
#	Dateiname: 		#	ANNO_Koordinatentabelle.lisp		#
#	Firma: 		#	Saalfelder Werkzeugmaschinen GmbH	#
#	Version: 		#	1.1							#
###########################################
|#

;RGB-Farben
;weiß	1,1,1	
;rot	1,0,0
;grün	0,1,0
;blau	0,0,1
;gelb	1,1,0
;cyan	0,1,1
;magenda	1,0,1
;schwarz	0,0,0

(in-package :test)
(use-package :oli)
(use-package :docu)		;muss bei ANNOTATION mit dazu


(sd-defdialog 'Kotab
 :dialog-title "Koordinatentabelle"
 :variables
  '(
      (NP_nr :value-type :positive-number
               :title "NP-nr."
			   ;:before-input (Pruefung) ;erwartet auch noch eine folgende Eingabe
               :initial-value  (Pruefung) ; geht nicht bei before-input --> erwartet keine folgende Eingabe lässt sie aber zu.
               :prompt-text "Nullpunktnummer eingeben"			
               :after-input (Pruefung)	
     );;Überschrift
	  (ansicht 	:selection   *sd-anno-view-seltype*         ; nur Ansichten wählbar
                :title       "Ansicht"
                :prompt-text "Ansicht angeben"
				:after-input (progn
								;(display (sd-am-view-struct-scale (sd-am-inq-view ansicht)))
								(setq mastab (/ 1 (sd-am-view-struct-scale (sd-am-inq-view ansicht))))
								; (display mastab)
							 )
      )
     ( a-wert :value-type :length
               :title "Anfangswert"
               :initial-value  10
               :prompt-text "Anfangswert eingeben"
               ;:after-input (setq a-wert Anfangswert)
     );;Anfangswert

     (Tab_row 		:initial-value 0); Zeilenzähler
     (Digits_x    	:initial-value 2);Anzahl der Nachkommastellen für die X-Werte
     (Digits_y    	:initial-value 2);Anzahl der Nachkommastellen für die Y-Werte
	 ;(line_dist  	:initial-value 8) ;Länge der horizontalen Textunterstreichlinie der Koordinatennummern 	
	 ;(line_dist_NP 	:initial-value 10) ;Länge der horizontalen NP-unterstreichlinie
     (Text_size_vor  :initial-value (sd-am-text-attributes-struct-size (sd-am-inq-curr-text-attributes)));voreingestellte Textgröße
     (Text_color_vor :initial-value (sd-am-text-attributes-struct-color (sd-am-inq-curr-text-attributes)));voreingestellte Textfarbe
     (Line_color_vor :initial-value (sd-am-geo-attributes-struct-color (sd-am-inq-curr-geometry-attributes)));voreingestellte Linienfarbe
     (old-wrong-owner-warning :initial-value DOCU::*DOCU-HIDE-WRONG-OWNER-WARNING*)

     (Tab_pos :value-type :docupoint
              :title "Tab. Pos."
              :prompt "Position fuer Koordinaten-Tabelle ?"
              :after-input (progn
                             (setq Tab_row 0)
                             (draw-table (format nil "Nullpunkt ~A" (sd-num-to-string NP_nr)) "Pkt" "X-Koord." "Y-Koord." "Tol." "Bemerkung")
                           )
              :next-variable 'Null_pnt
     )
     (Null_pnt :value-type :docupoint
               :title "Null Pkt."
               :prompt "Nullpunkt fuer Koordinaten?"
               :next-variable 'Null_pos
     )
     (Null_pos :value-type :docupoint
               :prompt "Position fuer Koordinaten-Nullpunkts-Text ?"
               :title "Null Pos."
               :before-input (sd-execute-annotator-command :cmd (format nil "TEXT 'NP~A' " (sd-num-to-string NP_nr)))
               :after-input (progn
									
									(setq line_dist_NP (+ (* (length (sd-num-to-string NP_nr)) 2) 7))
									;(display line_dist_NP)
									
									(setq Null_pnt_x (* (gpnt2d_x Null_pnt) mastab))
									(setq Null_pnt_y (* (gpnt2d_y Null_pnt) mastab))
									(setq Null_pos_x (* (gpnt2d_x Null_pos) mastab))
									(setq Null_pos_y (* (gpnt2d_y Null_pos) mastab))
									
									(setq dist_np1 (sqrt (+ (expt (- Null_pnt_x Null_pos_x) 2) (expt (- Null_pnt_y Null_pos_y) 2)))) ;Satz des Pytagoras
									(setq dist_np2 (sqrt (+ (expt (- Null_pnt_x (+ Null_pos_x line_dist_NP)) 2) (expt (- Null_pnt_y Null_pos_y) 2))))
									(setq sketch_name_ans (format nil "Koord ~A" (sd-num-to-string NP_nr)))
									; Skizze an der Ansicht erstellen
									(sd-call-cmds  (AM_SKETCH_CREATE
									:sketch_name sketch_name_ans
									:owner       ansicht
									:ref_point   Null_pnt
									))
									(sd-am-set-default-owner :text :sketch
									(format NIL "~A~A~A~A~A" (sd-am-inq-curr-sheet-name) "/"
									(sd-am-view-set-struct-name (sd-am-inq-view ansicht)) "/" sketch_name_ans)
									)
									(sd-am-set-default-owner :geo :sketch
									(format NIL "~A~A~A~A~A" (sd-am-inq-curr-sheet-name) "/"
									(sd-am-view-set-struct-name (sd-am-inq-view ansicht)) "/" sketch_name_ans)
									)

									(sd-call-cmds (AM_GEO_COLOR :color (sd-rgb-to-color 1,1,0))); gelbe Linienfarbe
									(sd-call-cmds (AM_TEXT_SETTINGS :color (sd-rgb-to-color 1,1,0))); gelbe Textfarbe
									(sd-call-cmds (AM_TEXT_SETTINGS :size 2.5)); Textgröße
									
									(sd-call-cmds (AM_GEO_LINE_HORIZONTAL
									(make-gpnt2d :x Null_pos_x :y (- Null_pos_y 1)) line_dist_NP))
	
									(if (< dist_np1 dist_np2)	; damit immer das kürzeste ende angebunden wird
										(sd-call-cmds (AM_GEO_LINE_2POS
											(make-gpnt2d :x Null_pnt_x :y Null_pnt_y)
											(make-gpnt2d :x Null_pos_x :y (- Null_pos_y 1))))
										(sd-call-cmds (AM_GEO_LINE_2POS
											(make-gpnt2d :x Koo_pnt_x :y Koo_pnt_y)
											(make-gpnt2d :x (+ Koo_pos_x line_dist_NP) :y (- Koo_pos_y 1))))
									);end if
									
									(sd-call-cmds (AM_CREATE_TEXT :GO :OK (format nil "NP ~A" (sd-num-to-string NP_nr))
														(make-gpnt2d :x Null_pos_x :y Null_pos_y)))
									
                            );end progn
               :next-variable 'Koo_pnt
     )
     (Koo_pnt :value-type :docupoint
              :prompt "Koordinaten-Punkt?"

              :title "Koord. Pkt."
              :next-variable 'Koo_pos
			  :after-input 	(progn
								(setq Digits_x 2)
								(setq Digits_y 2)
			  					(setq Koo_pnt_x (* (gpnt2d_x Koo_pnt) mastab))
								(setq Koo_pnt_y (* (gpnt2d_y Koo_pnt) mastab))
								(berechnen);startet die Berechnungsfunktion
								(setq Tab_row (+ 1 Tab_row))
							)
     )
	("X-Wertsteuerung")
	(wert_x 	:value-type :display-only
                :display-units :length
				:title "X-Wert"
	)
	(NK_x+1    	:push-action (progn
								(setq Digits_x (+ Digits_x 1))
								(berechnen)
							 )
				:title "     0,0?? +1"
				:next-variable 'Koo_pos
                :toggle-type :grouped-toggle)
    (NK_x-1    	:push-action (progn
								(setq Digits_x (- Digits_x 1))
								(berechnen)
							 )
				:title "     0,0?? -1"
				:next-variable 'Koo_pos
                :toggle-type :grouped-toggle)
	("Y-Wertsteuerung")
	(wert_y 	:value-type :display-only
                :display-units :length
				:title "Y-Wert"
	)
	(NK_y+1    	:push-action (progn
								(setq Digits_y (+ Digits_y 1))
								(berechnen)
							 )
				:title "     0,0?? +1"
				:next-variable 'Koo_pos
                :toggle-type :grouped-toggle)
    (NK_y-1    	:push-action (progn
								(setq Digits_y (- Digits_y 1))
								(berechnen)
							 )
				:title "     0,0?? -1"
				:next-variable 'Koo_pos
                :toggle-type :grouped-toggle)

     (Koo_pos :value-type :docupoint
              :prompt "Position fuer Koordinaten-Markierung ?"
              :title "Koord. Pos."
              ; :before-input (sd-execute-annotator-command :cmd (format nil "TEXT '~A: X-Wert:~5,2F Y-Wert:~5,2F'"
											; (sd-num-to-string (+ Tab_row a-wert)) wert_x wert_y))
              :before-input (sd-execute-annotator-command :cmd (format nil "TEXT '~A"
											(sd-num-to-string (+ Tab_row a-wert))))
              :after-input (progn
							;was das wohl tat?
                            ; (sd-execute-annotator-command :cmd (format nil "~A,~A END"
                                                   ; (gpnt2d_x Koo_pos)
                                                   ; (gpnt2d_y Koo_pos)))
							
							(setq koord_nr (+ Tab_row a-wert))
							(setq line_dist (+ (* (length (sd-num-to-string koord_nr)) 2) 3))
							;(display line_dist)

							(setq Koo_pos_x (* (gpnt2d_x Koo_pos) mastab))
							(setq Koo_pos_y (* (gpnt2d_y Koo_pos) mastab))	
							
							(setq dist_1 (sqrt (+ (expt (- koo_pnt_x koo_pos_x) 2) (expt (- koo_pnt_y koo_pos_y) 2))))
							(setq dist_2 (sqrt (+ (expt (- koo_pnt_x (+ koo_pos_x line_dist)) 2) (expt (- koo_pnt_y koo_pos_y) 2))))
							
							(sd-call-cmds (AM_GEO_COLOR :color (sd-rgb-to-color 1,1,0))); gelbe Linienfarbe
							(sd-call-cmds (AM_TEXT_SETTINGS :color (sd-rgb-to-color 1,1,0))); gelbe Textfarbe
							(sd-call-cmds (AM_TEXT_SETTINGS :size 2.5 :done)); Textgröße

							(sd-am-set-default-owner :text :sketch
							(format NIL "~A~A~A~A~A" (sd-am-inq-curr-sheet-name) "/"
							(sd-am-view-set-struct-name (sd-am-inq-view ansicht)) "/" sketch_name_ans)
							)
							(sd-am-set-default-owner :geo :sketch
							(format NIL "~A~A~A~A~A" (sd-am-inq-curr-sheet-name) "/"
							(sd-am-view-set-struct-name (sd-am-inq-view ansicht)) "/" sketch_name_ans)
							)

							(sd-call-cmds (AM_GEO_LINE_HORIZONTAL
							(make-gpnt2d :x Koo_pos_x :y (- Koo_pos_y 1)) line_dist))
							
							(if (< dist_1 dist_2)    ; damit immer das kürzeste ende angebunden wird
								(sd-call-cmds (AM_GEO_LINE_2POS
									(make-gpnt2d :x Koo_pnt_x :y Koo_pnt_y)
									(make-gpnt2d :x Koo_pos_x :y (- Koo_pos_y 1))))
								(sd-call-cmds (AM_GEO_LINE_2POS
									(make-gpnt2d :x Koo_pnt_x :y Koo_pnt_y)
									(make-gpnt2d :x (+ Koo_pos_x line_dist) :y (- Koo_pos_y 1))))
							);end if
							
							(sd-call-cmds (AM_CREATE_TEXT :GO :OK (sd-num-to-string koord_nr)
												(make-gpnt2d :x (+ Koo_pos_x 2) :y Koo_pos_y)))
									
							
                             (draw-table (format nil "Nullpunkt ~A" NP_nr)
										 (format nil "~A" (sd-num-to-string koord_nr))
                                         (format nil "~A" (sd-num-to-string wert_x))
                                         (format nil "~A" (sd-num-to-string wert_y))
                                         (format nil "Tol.")
                                         (format nil "Bemerkung")

							 )
                           )
              :next-variable 'Koo_pnt
	  )
    )




 :local-functions
  '(
     (round-digits_x (value_x pow_x)
       (/ (round (* value_x (expt 10.0 pow_x)))
       (expt 10.0 pow_x))
     )
	
     (round-digits_y (value_y pow_y)
       (/ (round (* value_y (expt 10.0 pow_y)))
       (expt 10.0 pow_y))
     )
	
	 (berechnen()
		(setq wert_x (round-digits_x (- Koo_pnt_x Null_pnt_x) Digits_x));ohne Massstab da dieser schon in den Koordinaten verrechnet wird
		(setq wert_y (round-digits_y (- Koo_pnt_y Null_pnt_y) Digits_y))
	 )
	
	 (Pruefung()
		(setq NP_num NP_nr)
		(if (numberp NP_num) () (setq NP_num 1)) ;Prüfung ob NP_nr eine Zahl ist sonst wir sie 1 gesetzt
		(setq sketch_name (format nil "NP ~A" (sd-num-to-string NP_num))) ;Skizzenname setzen
		(setq skizzen_liste (sd-am-inq-all-sketches (sd-am-inq-curr-sheet))) ; eine Skizzenliste aller Skizzen erstellen
		(setq skizzen_liste_nr (list )) ;Skizzenliste der Nummern erstellen
			(setq skizzen_liste_nr nil) ;Skizzenliste der Nummern erstellen leeren
			(dolist (skizze skizzen_liste) ;jeden Skizzennamen der Skizenliste durchlaufen
				(if (sd-string-match-pattern-p "NP *" (sd-am-inq-name skizze)) ;wenn sie 'NP ' enthält, dann wird die nachfolgende 
															;Nummer in die Skizzenliste der Nummern eingefügt.
				(push (read-from-string (sd-string-replace (sd-am-inq-name skizze) "NP " "")) skizzen_liste_nr)
				)
			)
		(sort skizzen_liste_nr #'<);sortieren der Skizzenliste
		;(display skizzen_liste_nr)
		(dolist (Nummer skizzen_liste_nr) ;jede Skizzennummer in der Nummernliste durchlaufeb
			(loop
				(if (= Nummer NP_num)
					; (display (format nil "~A gleich ~A" Nummer NP_nr))	
					(setq NP_num (+ NP_num 1));then
					; (display (format nil "~A ungl. ~A" Nummer NP_nr))
					(return "done")
				);end if
			);end loop
		);end dolist
		(setq NP_nr NP_num)
	 );end Prüfung

     (draw-table (NPnr no x-txt y-txt tol bem)
        (if (= Tab_row 0)
		  (progn
			(setq Tab_pos_x (gpnt2d_x Tab_pos))
			(setq Tab_pos_y (gpnt2d_y Tab_pos))
			(setq Zeilenhoehe 2.5)
			
			; Skizze auf dem aktuellen Blatt erstellen
			(sd-call-cmds  (AM_SKETCH_CREATE
			:sketch_name sketch_name
			:owner      :current_sheet
			:ref_point   Tab_pos
			))
			; Skizze als aktuellen Besitzer der folgenden Geometrie festlegen
			(sd-am-set-default-owner :geo :sketch
			(format NIL "~A~A~A" (sd-am-inq-curr-sheet-name) "/" sketch_name)
			)	
			; Skizze als aktuellen Besitzer der folgenden Text festlegen
			(sd-am-set-default-owner :text :sketch
			(format NIL "~A~A~A" (sd-am-inq-curr-sheet-name) "/" sketch_name)
			)			
			(sd-call-cmds (AM_GEO_COLOR :color (sd-rgb-to-color 1,1,1)));weiß für die Kopflinien
			
			(sd-call-cmds  (AM_GEO_LINE_HORIZONTAL	(make-gpnt2d :x Tab_pos_x :y Tab_pos_y) (* 38 Text_size_vor)))
			(sd-call-cmds  (AM_GEO_LINE_HORIZONTAL	(make-gpnt2d :x Tab_pos_x
																 :y (- Tab_pos_y (* (+ Tab_row 1) Zeilenhoehe Text_size_vor)))
																 (* 38 Text_size_vor)))
			(sd-call-cmds  (AM_GEO_LINE_VERTICAL	(make-gpnt2d :x (+ Tab_pos_x (* 0 Text_size_vor))
															 	 :y (- Tab_pos_y (* (+ Tab_row 1) Zeilenhoehe Text_size_vor)))
																 (* Zeilenhoehe Text_size_vor)))
			(sd-call-cmds  (AM_GEO_LINE_VERTICAL	(make-gpnt2d :x (+ Tab_pos_x (* 38 Text_size_vor))
																 :y (- Tab_pos_y (* (+ Tab_row 1) Zeilenhoehe Text_size_vor)))
																 (* Zeilenhoehe Text_size_vor)))

			(sd-call-cmds (AM_TEXT_SETTINGS :color (sd-rgb-to-color 1,1,1)));weiß für den Kopftext
			(sd-call-cmds (AM_TEXT_SETTINGS :size 3.5));Textgröße 3.5 für die Tabellenüberschrift			
			(sd-call-cmds (AM_CREATE_TEXT :GO :OK NPnr (make-gpnt2d :x (+ Tab_pos_x (* 15 Text_size_vor))
																	:y (- Tab_pos_y (* (+ Tab_row 1) Zeilenhoehe Text_size_vor) -1.5))))

		  )
		  (setq Zeilenhoehe 2)
        );end if
		
		; Skizze als aktuellen Besitzer der folgenden Geometrie festlegen
		(sd-am-set-default-owner :geo :sketch
		(format NIL "~A~A~A" (sd-am-inq-curr-sheet-name) "/" sketch_name)
		)

		; Skizze als aktuellen Besitzer der folgenden Text festlegen
		(sd-am-set-default-owner :text :sketch
		(format NIL "~A~A~A" (sd-am-inq-curr-sheet-name) "/" sketch_name)
		)

		(if (= Tab_row 0) ;abfrage ob noch die Kopfzeile Geschrieben wird
			(progn
				(sd-call-cmds (AM_GEO_COLOR :color (sd-rgb-to-color 1,1,1)));weiß für die Tabellenlinien	
				(sd-call-cmds (AM_TEXT_SETTINGS :color (sd-rgb-to-color 0,1,0)));grün für die Spaltentexte
			)
			(progn
				(sd-call-cmds (AM_GEO_COLOR :color (sd-rgb-to-color 1,1,0)));gelb für die Tabellenlinien	
				(sd-call-cmds (AM_TEXT_SETTINGS :color (sd-rgb-to-color 1,1,0)));gelb für die Tabellentexte
			)
		)

		(sd-call-cmds (AM_TEXT_SETTINGS :size 2.5));Textgröße 2.5 für den Tabellentext	

		(sd-call-cmds  (AM_GEO_LINE_HORIZONTAL	(make-gpnt2d :x Tab_pos_x
															 :y (- Tab_pos_y (* (+ Tab_row 2.5) 2 Text_size_vor)))
															 (* 38 Text_size_vor)))
		(sd-call-cmds  (AM_GEO_LINE_VERTICAL	(make-gpnt2d :x (+ Tab_pos_x (* 0 Text_size_vor))
															 :y (- Tab_pos_y (* (+ Tab_row 2.5) 2 Text_size_vor)))
															 (* Zeilenhoehe Text_size_vor)))
		(sd-call-cmds  (AM_GEO_LINE_VERTICAL	(make-gpnt2d :x (+ Tab_pos_x (* 4 Text_size_vor))
															 :y (- Tab_pos_y (* (+ Tab_row 2.5) 2 Text_size_vor)))
															 (* Zeilenhoehe Text_size_vor)))
		(sd-call-cmds  (AM_GEO_LINE_VERTICAL	(make-gpnt2d :x (+ Tab_pos_x (* 12 Text_size_vor))
															 :y (- Tab_pos_y (* (+ Tab_row 2.5) 2 Text_size_vor)))
															 (* Zeilenhoehe Text_size_vor)))
 		(sd-call-cmds  (AM_GEO_LINE_VERTICAL	(make-gpnt2d :x (+ Tab_pos_x (* 20 Text_size_vor))
															 :y (- Tab_pos_y (* (+ Tab_row 2.5) 2 Text_size_vor)))
															 (* Zeilenhoehe Text_size_vor)))
  		(sd-call-cmds  (AM_GEO_LINE_VERTICAL	(make-gpnt2d :x (+ Tab_pos_x (* 27 Text_size_vor))
															 :y (- Tab_pos_y (* (+ Tab_row 2.5) 2 Text_size_vor)))
															 (* Zeilenhoehe Text_size_vor)))
  		(sd-call-cmds  (AM_GEO_LINE_VERTICAL	(make-gpnt2d :x (+ Tab_pos_x (* 38 Text_size_vor))
															 :y (- Tab_pos_y (* (+ Tab_row 2.5) 2 Text_size_vor)))
															 (* Zeilenhoehe Text_size_vor)))

		(sd-call-cmds (AM_CREATE_TEXT :GO :OK no (make-gpnt2d :x (+ Tab_pos_x 2)
																:y (- Tab_pos_y (* (+ Tab_row 2.5) 2 Text_size_vor) -1.5))))
		(sd-call-cmds (AM_CREATE_TEXT :GO :OK x-txt (make-gpnt2d :x (+ Tab_pos_x (+ 2 (* 4 Text_size_vor)))
																:y (- Tab_pos_y (* (+ Tab_row 2.5) 2 Text_size_vor) -1.5))))
		(sd-call-cmds (AM_CREATE_TEXT :GO :OK y-txt (make-gpnt2d :x (+ Tab_pos_x (+ 2 (* 12 Text_size_vor)))
																:y (- Tab_pos_y (* (+ Tab_row 2.5) 2 Text_size_vor) -1.5))))
		(sd-call-cmds (AM_CREATE_TEXT :GO :OK tol (make-gpnt2d :x (+ Tab_pos_x (+ 2 (* 20 Text_size_vor)))
																:y (- Tab_pos_y (* (+ Tab_row 2.5) 2 Text_size_vor) -1.5))))
		(sd-call-cmds (AM_CREATE_TEXT :GO :OK bem (make-gpnt2d :x (+ Tab_pos_x (+ 2 (* 27 Text_size_vor)))
																:y (- Tab_pos_y (* (+ Tab_row 2.5) 2 Text_size_vor) -1.5))))
		(sd-call-cmds (AM_GEO_COLOR :color (sd-rgb-to-color Line_color_vor))); rücksetzen auf vorgabe
		(sd-call-cmds (AM_TEXT_SETTINGS :color (sd-rgb-to-color Text_color_vor))); rücksetzen auf vorgabe
		(sd-call-cmds (AM_TEXT_SETTINGS :size Text_size_vor)); rücksetzen auf vorgabe
     )

   )
     :after-initialization '(setq DOCU::*DOCU-HIDE-WRONG-OWNER-WARNING* T)
	 :cleanup-action
			'(progn
				(setq DOCU::*DOCU-HIDE-WRONG-OWNER-WARNING* old-wrong-owner-warning)
				(sd-execute-annotator-command :cmd "CANCEL")
				;; ++ eventuell noch:
				(sd-call-cmds (am_current_sheet (sd-am-inq-curr-sheet-name)))
				) 
)