;;--------------------------------------------------------------------------*
;;  Makro für Annotation zum Erzeugen einer Skizze, in der allgemeine und   *
;;  spezielle Oberflächen der Zeichnung angegeben werden 23.05.2005  V 1.1  *
;;--------------------------------------------------------------------------*

(in-package :custom)

(use-package :OLI)

;;--------------------------------------------------------------------------*
;;     global variables                                                     *
;;--------------------------------------------------------------------------*

(defvar oberflaechen-symbol-groesse)
(defvar oberflaechen-symbol-abstand)
(defvar oberflaechen-symbol-farbe)

(setf oberflaechen-symbol-groesse 5)      ;; entspricht der eingestellten Symbolgroesse
(setf oberflaechen-symbol-abstand 2.5)    ;; Abstand der Symbole zueinander, beliebige Zahl, 2-2.5 passt ganz gut
(setf oberflaechen-symbol-farbe 1,1,1)    ;; Rot,Gruen,Blau-Farbwert, 1,1,0 ist gelb

;;--------------------------------------------------------------------------*
;;     dialoge                                                              *
;;--------------------------------------------------------------------------*

(sd-defdialog 'oberflaechensymbol-dialog-erzeugen
:dialog-title "Allg. Oberflaeche"
:variables
  '(
    (rauhlist	 	:initial-value (list))
    (bezugspunkt	:value-type :docupntcnp
           		:prompt-text "Bezugspunkt fuer Allgemeines Oberflaechensymbol angeben"
           		:title "Position"
    )
    (rauhtext		:value-type :string
           		:prompt-text "Wert fuer allgemeine Rauhigkeit angeben"
           		:title "Allg.Rauh."
           		:initial-value "roh"
    )
    (symbolgroesse	:range (2.5 3.5 5 7)
           		:prompt-text "Symbolgroesse fuer Allgemeines Oberflaechensymbol angeben."
          		:title "Groesse"
          	 	:initial-value oberflaechen-symbol-groesse
           		:after-input (after-symbolgroesse-action)
    )
   ) ;end variables
   
:after-initialization '(init-action)
:local-functions
  '(
    (init-action ()
     (let (symblist symb parlist par rauh rauhz rauhzlist)
      (setf symblist (sd-call-cmds
                                 (get_selection
                                  :focus_type *sd-anno-symbol-seltype*
                                  :select
                                  :by_drawing_docu_rest)))
      (setf rauhzlist (list))
      (setf rauhz 1/2)
      (dolist (symb symblist)
       (setf parlist (sd-am-inq-symbol-param-names symb))
;       (display parlist)
       (dolist (par parlist)
        (when (or (sd-string= par "a1") (sd-string= par "a2"))
         (progn
          (setf rauh (first (getf (sd-am-inq-symbol-param symb par) :value)))
;          (display (format nil "~a=~a" par rauh))
          (setf rauhz (read-from-string (sd-string-replace rauh "," ".")))
          (push rauhz rauhzlist)
         );;progn
        );;when
       );;dolist
      );;dolist
;      (display rauhlist)
      (when (> (length rauhzlist) 0)
       (progn
        (setf rauhzlist (sort (remove-duplicates rauhzlist :test #'=) #'>))
        (setf displist (list))
        (dolist (rauhz rauhzlist)
         (push (list (format nil "~3,1,,,'0F" rauhz)) rauhlist)
        );;dolist
        (sd-change-logical-table-contents "oberfl-log-tabelle" :contents rauhlist)
        (oberflaechen-tabelle-zeigen)
       );;progn
      );;when
     );;let
    )
    (after-symbolgroesse-action ()
     (let ()
      (setf oberflaechen-symbol-groesse symbolgroesse)
     )
    )
    (next-action ()
     (let ()
      (oberflaechen-symbol-zeichnen bezugspunkt rauhlist rauhtext)
     )
    )
   )
 :ok-action
    '(next-action)
 :help-action '(sd-display-url (format nil "~a#Allgemeines_Oberflaechensymbol" *dc4-hilfe-datei*))
)


;;--------------------------------------------------------------------------*
;;     functions                                                            *
;;--------------------------------------------------------------------------*

;;--------------------------------------------------------------------------*
;;     Funktion: oberflaechen-symbol-zeichnen                           *
;;                                                                          *
;;               Allgemeines Oberflaechensymbol Zeichnen                    *
;;                                                                          *
;;     Parameter : ppkt ... Punkt fuer Symbol                               *
;;                 rauhlist...Liste von Strings                             *
;;                 rauhtext...String                                           *
;;                                                                          *
;;     Returnwert: t ... alles ok                                           *
;;                 nil ... sonst                                            *
;;                                                                          *
;;  mr 23.05.05                                                        *
;;-------------------------------------------------------------------------*/

(defun oberflaechen-symbol-zeichnen (ppkt rauhlist rauhtext)
 (let (ret ss pp fehler tmp_sketch_name name_pp p1 p2 p3 p4 p5 p6 ohne_warn rauh)
  (case oberflaechen-symbol-groesse
   (2.5 (setf ss 3.5))
   (3.5 (setf ss 5))
   (5 (setf ss 7))
   (7 (setf ss 10))
   (t nil)
  );;case
  (setf pp (make-gpnt2d :x (oli::gpntdocu_x ppkt)
                        :y (oli::gpntdocu_y ppkt)))

  ;; die Skizze erzeugen
  (oli::sd-am-set-default-owner :sketch :current-sheet)
  (setf fehler nil)
  (setf tmp_sketch_name "Allgemeine_Oberflaeche_TEMP")
  (sd-call-cmds (AM_SKETCH_CREATE :GO :OK :sketch_name tmp_sketch_name
                     :REF_POINT ppkt)
      :failure (setf fehler t))

  (when fehler
    (progn
      (display "oberflaechen-symbol-zeichnen")
      (display "Unerwarteter Fehler beim Erzeugen der Skizze :")
      (display (sd-inq-error-obj :message))
    )
  )

  (setf curr_sheet_name (sd-am-inq-curr-sheet-name))
  (setf name_pp (format nil "~a/~a" curr_sheet_name tmp_sketch_name))

  ;; alles was nun kommt, soll zur Skizze gehoeren
  (oli::sd-am-set-default-owner :geo :sketch name_pp)
  (oli::sd-am-set-default-owner :text :sketch name_pp)
  (oli::sd-am-set-default-owner :symbol :sketch name_pp)

  ;; das allgemeine Symbol zeichnen
  
  ;folge Zeile soll die Symbolgröße auf 5 und die Farbe auf weiß einstellen
  (AM_SYMBOL_SETTINGS :type "SURFACE" :size_abs 5.0 :all_color :color 16777215 :done)

  (setf p1 (sd-vec-add pp (make-gpnt2d :x (+ 0 (* oberflaechen-symbol-abstand 1.4 ss)) :y 0)))
  (setf p2 (sd-vec-add pp  (make-gpnt2d :x (+ 0 (* oberflaechen-symbol-abstand 0.5 ss)) :y 0)))
  (setf ohne_warn   docu::*docu-hide-wrong-owner-warning*)
  (setf docu::*docu-hide-wrong-owner-warning* t)
  (if (sd-string= rauhtext "roh")
   (sd-call-cmds (AM_CREATE_SYMBOL_SURFACE :go :ok pp :form 3)  :failure (setf fehler t))
   (sd-call-cmds (AM_CREATE_SYMBOL_SURFACE :go :ok pp :form 2 :a1 rauhtext)  :failure (setf fehler t))
  )
  (setf docu::*docu-hide-wrong-owner-warning* ohne_warn)

  (OLI::AM_GEO_DEFAULT :color :rgb oberflaechen-symbol-farbe)
  (OLI::AM_GEO_DEFAULT :line_type :SOLID)
  (setf p3 (sd-vec-add pp (make-gpnt2d :x (+ 0 (* 1.5 ss)) :y (+ 0 (* 1 ss)))))
  (setf p4 (sd-vec-add p3 (make-gpnt2d :x (+ 0 (* 0.5 ss)) :y (+ 0 (* 1.5 ss)))))
  (setf p5 (sd-vec-add p3 (make-gpnt2d :x (+ 0 (* 0.5 ss)) :y (- 0 (* 1.5 ss)))))
  (setf p6 (sd-vec-add pp (make-gpnt2d :x (+ 0 (* 0.5 ss)) :y (+ 0 (* 1 ss)))))
  (setf ohne_warn docu::*docu-hide-wrong-owner-warning*)
  (setf docu::*docu-hide-wrong-owner-warning* t)
  (when (> (length rauhlist) 0)
   (progn
    (sd-call-cmds (AM_GEO_ARC_3POS :GO :OK p4 p5 p3) :failure (setf fehler t))
    (dolist (rauh rauhlist)
     (sd-call-cmds (AM_CREATE_SYMBOL_SURFACE :go :ok p1 :form 2 :a1 (first rauh))  :failure (setf fehler t))
     (setf p1 (sd-vec-add p1 (make-gpnt2d :x (+ 0 (* oberflaechen-symbol-abstand ss)) :y 0)))
     (setf p6 (sd-vec-add p6 (make-gpnt2d :x (+ 0 (* oberflaechen-symbol-abstand ss)) :y 0)))
    );;dolist
    (setf p6 (sd-vec-add p6 (make-gpnt2d :x (+ 0 (* oberflaechen-symbol-abstand ss)) :y 0)))
    (setf p7 (sd-vec-add p6 (make-gpnt2d :x (- 0 (* 0.5 ss)) :y (+ 0 (* 1.5 ss)))))
    (setf p8 (sd-vec-add p6 (make-gpnt2d :x (- 0 (* 0.5 ss)) :y (- 0 (* 1.5 ss)))))
    (sd-call-cmds (AM_GEO_ARC_3POS :GO :OK p7 p8 p6) :failure (setf fehler t))
   );;progn
  );;when
  (setf docu::*docu-hide-wrong-owner-warning* ohne_warn)

 ;folge Zeile soll die Symbolgröße auf 3.5 und die Farbe wieder auf gelb einstellen
  (AM_SYMBOL_SETTINGS :type "SURFACE" :size_abs 3.5 :all_color :color 16776960 :done)

  ;; die Skizze umbenennen
  ;;(display "Umbenennen")
  (sd-call-cmds (AM_SKETCH_RENAME :sketch name_pp :new_name "Allgemeine_Oberflaeche"))

 )
)

;;--------------------------------------------------------------------------*
;;     Funktion: oberflaechen-tabelle-zeigen                                 *
;;               Zeigt die gefundenen Oberflächenwerte                      *
;;                                                                          *
;;     Parameter :                                                          *
;;                 keiner                                                   *
;;                                                                          *
;;     Returnwert: keiner                                                   *
;;                                                                          *
;;  mr 23.05.2005                                                      *
;;-------------------------------------------------------------------------*/

(defun oberflaechen-tabelle-zeigen ()
 (let ()
  (sd-show-display-table "oberflaechen-display-table" :position '("oberflaechensymbol-dialog-erzeugen-OPTIONS-OPT-CONT-bezugspunkt-TB" :leftcenter -10 -20))
 );;let
)
;;--------------------------------------------------------------------------*
;;     tables                                                               *
;;--------------------------------------------------------------------------*

(defun erzeuge-oberflaechen-tabellen ()

  (sd-create-logical-table "oberfl-log-tabelle"
    :columnNames '("Rauhwerte")
    :columns     '(:rauh)
    :types       '(:string)
  )

(sd-create-display-table "oberflaechen-display-table"
     :tableTitle             "Rauhigkeitswerte"
     :logicalTable           "oberfl-log-tabelle"
     :columns     '(:rauh)
     :applyColumns           '()
     :selectionMode          :single-row
     :applyAction            '()
     :afterApplyBehavior   nil ;; Tabelle bleibt eingeblendet
;;	        :displayHeight 200
     :filterStatusLine nil
 )
)

(erzeuge-oberflaechen-tabellen)