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

;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 :length
               :title "NP-nr."
			   :before-input (Pruefung)			   
               ; :initial-value  1 ; geht nicht bei before-input
               :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)
							 )
      )
	  ; (mastab 	:value-type :display-only
                ; :display-units :length
				; :title "Massstab"
	  ; )
     ; ( Masstab :value-type :length
               ; :title "Massstab"
               ; :initial-value  2
               ; :prompt-text "Faktor eingeben"
               ; :after-input (setq mastab (/ 1 Masstab))
     ; );;Masstab wird aus ansicht ermittelt
     ( 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


     (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 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 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 (+ Tab_row a-wert)) 
												(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 (+ Tab_row a-wert)))
                                         (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()
		(if (numberp NP_nr) () (setq NP_nr 1))
		; (display NP_nr)
		; (loop
			(setq sketch_name (format nil "NP ~A" (sd-num-to-string NP_nr)))
			(setq skizzen_liste (sd-am-inq-all-sketches (sd-am-inq-curr-sheet)))
			(setq skizzen_liste_nr (list ))
				(setq skizzen_liste_nr nil)
				(dolist (skizze skizzen_liste)
					(if (sd-string-match-pattern-p "NP *" (sd-am-inq-name skizze))
					(push (read-from-string (sd-string-replace (sd-am-inq-name skizze) "NP " "")) skizzen_liste_nr)
					)
				)
			(sort skizzen_liste_nr #'string-lessp)
			; (display skizzen_liste_nr)
			; (loop
			(dolist (Nummer skizzen_liste_nr)
				(loop
					(if (= Nummer NP_nr)
						(progn
						; (display NP_nr)
						; (display (format nil "~A gleich ~A" Nummer NP_nr))	
						(setq NP_nr (+ NP_nr 1))
						)
						(progn
						; (display NP_nr)
						; (display (format nil "~A ungl. ~A" Nummer NP_nr))
						(return "done")
						)					
					)
				)
			)
			; )
	 )
     
     (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)
        )
		
		; 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
     )
	 (abbruch()
	 ;(display "cancel")
	 (sd-execute-annotator-command :cmd (format nil "TEXT '~A" " ")); die Cursoranzeige bei Abbruch zurücksetzen
	 ; ()
	 )
   )
	 :cancel-action  '(abbruch)
)