;;--------------------------------------------------------------------------*
;;  Copyright 2002  TECHSOFT RAND                                           *
;;                                                                          *
;;--------------------------------------------------------------------------*
;;  Dateiname: tsam_broke.lsp 
;;  Version  : 1.0         
;;  Datum    : 31.01.2002   
;;  Author   : Schaumberger G
;;--------------------------------------------------------------------------*
;;  Modulbeschreibung: Bemassen zwischen zwei Teilansichten                 *
;;                                                                          *
;;                                                                          *
;;                                                                          *
;;--------------------------------------------------------------------------*
;;  Hilfsmittel:                                                            *
;;                                                                          *
;;--------------------------------------------------------------------------*
;;  Zugehoerige Moduln:                                                     *
;;     Name     |    Kurzbeschreibung                                       *
;;              |                                                           *
;;              |                                                           *
;;--------------------------------------------------------------------------*
;;  Wichtige Informationen:                                                 *
;;--------------------------------------------------------------------------*
;;  Anderungsverzeichnis:                                                   *
;;   Version   |  Datum   |   Autor    |  Beschreibung                      *
;;             |          |            |                                    *
;;             |          |            |                                    *
;;--------------------------------------------------------------------------*

;;--------------------------------------------------------------------------*
;;     in-packages                                                          *
;;--------------------------------------------------------------------------*

(in-package :custom)

;;--------------------------------------------------------------------------*
;;     use-packages                                                         *
;;--------------------------------------------------------------------------*

(use-package :OLI)
(use-package :frame2)
 
;;--------------------------------------------------------------------------*
;;     export                                                               *
;;--------------------------------------------------------------------------*

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

;;***************************************************************************
;;     DIALOGS                                                              *
;;***************************************************************************
;; Testdialog Flaeche
(sd-defdialog 'ts-am-broke
;;:toolbox-button nil
:dialog-title "Bem-Bruchans."
:dialog-type :terminate
:dialog-control :parallel
:module "ANNOTATION"
 :after-initialization
     '(progn
        (setf curr-sheet (sd-am-inq-curr-sheet))
        (if curr-sheet
          (progn
            (setf akt_teil (sd-execute-annotator-function :fnc
                "Ts_am_broke_get_curr_part"))
            (sd-execute-annotator-command :cmd (format nil  
               "EDIT_PART '~a'" (sd-am-inq-unique-name curr-sheet)))
          )
          ;; else
          (progn
            (sd-display-error "Ein Blatt muss aktiv sein")
            (cancel)
          )
        )
          
      )
:variables 
  '(
    (curr-sheet)
    (akt_teil)
    ("BemRichtung")
    (para :value-type :boolean
          :title "Parallel"
          ;;:toggle-type :wide-toggle
          :initial-value t
          :after-input (start-dim-position-feedback)
        :next-variable 
           (if (and p1 p2)
              'p3
              'p1
           )
    )
    (hori :value-type :boolean
          :title "Horizontal"
          :initial-value nil
          :after-input (start-dim-position-feedback)
        :next-variable 
           (if (and p1 p2)
              'p3
              'p1
           )
    )
    (vert :value-type :boolean
          :title "Vertikal"
          :initial-value nil
          :after-input (start-dim-position-feedback)
        :next-variable 
           (if (and p1 p2)
              'p3
              'p1
           )
    )
    ("BemPositionieren")
    (p1 :value-type :docupntcnp
        :prompt-text "Ersten Punkt fÏr BemaÞung angeben."
        :title "Punkt 1"
        :check-function valid-point
        :before-input
          (progn
            (start-line-feedback)
          )
        :next-variable 
           (if (and p1 p2)
              'p3
              'p2
           )
    )
    (p2 :value-type :docupntcnp
        :prompt-text "Zweiten Punkt fÏr BemaÞung angeben."
        :title "Punkt 2"
        :check-function valid-point
        :before-input
          (progn
            (start-line-feedback)
          )
        :next-variable 
           (if (and p1 p2)
              'p3
              'p1
           )
    )
    (p3 :value-type :docupntcnp
        :toggle-type :invisible
        :title "BemPos"
        :prompt-text "Position fÏr BemaÞung angeben."
        :before-input
          (progn
            (end-line-feedback)
            (start-dim-position-feedback)
          )
        :after-input 
          (progn
             (bemassen)
             ;;(sd-accept-dialog) ;; nichts mehr zu tun
             (cancel) ;; nichts mehr zu tun
          )
    )
   )
:mutual-exclusion '((para vert hori))
:local-functions
  '(
    (start-dim-position-feedback ()
      (when (and p1 p2)
       (progn
         (sd-execute-annotator-command :cmd (format nil
           "DIM_LINE ~a ~a,~a ~a,~a" (get-ri) (gpntdocu_x p1) (gpntdocu_y p1)
               (gpntdocu_x p2) (gpntdocu_y p2)
         ))
       )
      )
    )
    ;;---------------------------------------------------------------------
    (get-ri ()
      (let (ri)
       (cond  
         (para (setf ri "PARALLEL"))
         (hori (setf ri "HORIZONTAL"))
         (vert (setf ri "VERTICAL"))
       )
       ri
      )
    )
    ;;---------------------------------------------------------------------
    (end-dim-position-feedback ()
         (sd-execute-annotator-command :cmd "END")
    )
    ;;---------------------------------------------------------------------
    (start-line-feedback ()
     (let (p)
      (when (and (or p1 p2) (not (and p1 p2)))
        (progn
         (if p1
           (setf p p1)
           (setf p p2)
         )
         (sd-execute-annotator-command :cmd (format nil
              "DIM_LINE ~a,~a" (gpntdocu_x p) (gpntdocu_y p)))
        )
      )
     )
    )
    ;;---------------------------------------------------------------------
    (end-line-feedback ()
         (sd-execute-annotator-command :cmd "END")
    )
    ;;---------------------------------------------------------------------
    (valid-point (p)
     (let (ret)
      (setf ret (ts-am-broke-check-valid-dim-point p))
      (start-line-feedback)
      ret
     )
    )
    ;;---------------------------------------------------------------------
    ;; Liefert richtigen Bemassungswert (wenn moeglich)
    (get-dim-val ( v1 v2 dim_addr)
     (let (new-dim-val li m1 t1 r1 mr1 m2 t2 r2 mr2 view_part_id1 view_part_id2
           p1 p2 p12 p22 p13 p23 p14 p24 vec1 vec2 vec3 im1 im2 p3 p4)
       (setf new-dim-val "?")
       (setf li (ts-am-broke-get-2d3d-matr v1))
       ;;(display "2d3D View 1")
       ;;(display li)
       (setf m1 (nth 0 li)) ;; Transformationsmatrix
       (setf t1 (nth 1 li)) ;; Verschiebungsvektor
       (setf r1 (nth 2 li)) ;; Rotationswinkel
       (setf mr1 (nth 3 li)) ;; Rotationsmittelpunkt
       (setf li (ts-am-broke-get-2d3d-matr v2))
       ;;(display "2d3D View 2")
       ;;(display li)
       (setf m2 (nth 0 li)) ;; Transformationsmatrix
       (setf t2 (nth 1 li)) ;; Verschiebungsvektor
       (setf r2 (nth 2 li)) ;; Rotationswinkel
       (setf mr2 (nth 3 li)) ;; Rotationsmittelpunkt

       (when (and m1 m2     ;; Transformationsmat. sind ermittelbar
                  (< (abs (- r1 r2)) 0.000001) ;; identer Roationswinkel
                  (ts-am-broke-ident-2d3d-matr m1 m2) ;; gleiche Transf.
             )
        (progn
          ;;(display "Werteberechnung")
          (setf view_part_id1 (sd-am-inq-unique-name v1))
          (setf view_part_id2 (sd-am-inq-unique-name v2))
          (setf li (sd-execute-annotator-function :fnc (format nil 
            "Ts_am_broke_get_points_in_view_parts '~a' '~a' ~a"
                view_part_id1 view_part_id2 dim_addr)))

          ;;(display li)

    
          (setf ret (first li))
          (when ret
            (progn
             (setf p1 (second li))
             (setf p2 (third li))
             (setf p1  (make-gpnt3d :x (gpnt2d_x p1) :y  (gpnt2d_y p1) :z 0.0))
             (setf p2  (make-gpnt3d :x (gpnt2d_x p2) :y  (gpnt2d_y p2) :z 0.0))
             (setf li (sd-execute-annotator-function :fnc (format nil 
               "Ts_am_broke_get_dim_points_in_view_parts '~a' '~a' ~a"
                   view_part_id1 view_part_id2 dim_addr)))
             (setf p3 (second li))
             (setf p4 (third li))
             (setf p3  (make-gpnt3d :x (gpnt2d_x p3) :y  (gpnt2d_y p3) :z 0.0))
             (setf p4  (make-gpnt3d :x (gpnt2d_x p4) :y  (gpnt2d_y p4) :z 0.0))
             (setf vec3 (sd-vec-subtract p4 p3))            

             ;;(display (format nil "p1 = ~a" p1))
             ;;(display (format nil "p2 = ~a" p2))
             ;; zurueck rotieren der Punkte 
             (when (> (abs r1) 0.000001)
              (progn
                ;;(display "Rotieren der Punkte")
                (setf vec1 (sd-vec-subtract p1 mr1))
                (setf vec2 (sd-dir-rotate vec1 r1
                     :point (make-gpnt3d :x 0.0 :y 0.0 :z 0.0)
                     :direction (make-gpnt3d :x 0.0 :y 0.0 :z -1.0)))
                (setf p1 (sd-vec-add mr1 vec2))

                (setf vec1 (sd-vec-subtract p2 mr2))
                (setf vec2 (sd-dir-rotate vec1 r2
                     :point (make-gpnt3d :x 0.0 :y 0.0 :z 0.0)
                     :direction (make-gpnt3d :x 0.0 :y 0.0 :z -1.0)))
                (setf p2 (sd-vec-add mr2 vec2))

                (setf vec3 (sd-dir-rotate vec3 r1
                     :point (make-gpnt3d :x 0.0 :y 0.0 :z 0.0)
                     :direction (make-gpnt3d :x 0.0 :y 0.0 :z -1.0)))
              )
             )

             ;; Verschieben der Punkte
             (setf p12 (sd-vec-subtract p1 t1))
             (setf p22 (sd-vec-subtract p2 t2))

             ;;(display (format nil "p12 = ~a" p12))
             ;;(display (format nil "p22 = ~a" p22))

             ;;--------------------------------------------------
             ;; folgendes ist ja gar nicht noetig, da die beiden
             ;;  Transformationen ja gleich sind
             ;; die inversen Transformationsmatrizen
             ;;(setf p13 (make-gpnt3d :x (gpnt2d_x p12) :y (gpnt2d_y p12) :z 0.0))
             ;;(setf p23 (make-gpnt3d :x (gpnt2d_x p22) :y (gpnt2d_y p22) :z 0.0))
             ;;(display (format nil "p13 = ~a" p13))
             ;;(display (format nil "p23 = ~a" p23))
   
             ;;(setf im1 (get-inverse-matrix m1))
             ;;(setf im2 (get-inverse-matrix m2))
   
             ;;(display "INVERSE MATRIZEN")
             ;;(display im1)
             ;;(display im2)

             ;;(setf p14 (k2::pos-transformation-3d p13 im1))
             ;;(setf p24 (k2::pos-transformation-3d p23 im2))
             ;;(setf abstand (sd-vec-subtract p24 p14))
             ;;(display (format nil "p14 = ~a" p14))
             ;;(display (format nil "p24 = ~a" p24))
             ;;--------------------------------------------------

             (setf vec1 (sd-vec-subtract p22 p12))
             ;;(display (format nil "vec1= ~a" vec1))
             ;;(display (format nil "vec3= ~a" vec3))
             (if (and (sd-vec-cross-product vec1 vec3) 
                      (> (sd-vec-length (sd-vec-cross-product vec1 vec3)) 0.00001) 
                 )
               (progn
                 (setf abstand (sd-vec-length (sd-vec-subtract p12 p22)))
                 (setf phi (sd-vec-angle-between vec1 vec3))
                 ;;(display (format nil "phi= ~a" phi))
                 (setf abstand (* abstand (cos phi)))
                 (setf abstand (abs abstand))
               )
               ;; else
               (setf abstand (sd-vec-length (sd-vec-subtract p12 p22)))
             ) ;; if

             (setf abstand (conv-to-units abstand))
             (setf new-dim-val (format-dim-val abstand))
            )
          )
        )
       )

       ;;(display (format nil "new-dim-val calculated = <~a>" new-dim-val))
       new-dim-val
     )
    )
    ;;---------------------------------------------------------------------
    (format-dim-val ( dim-val )
     (let (dvs li cl fs)

      
      (setf dvs (sd-num-to-string dim-val))
      (setf li (sd-string-split dvs "."))
      (when (> (length li) 1)
       (progn
          (setf cl (sd-am-inq-default-dim-main-length-unit))
          (cond
           ((equal cl :MM)
             (setf fs (sd-am-inq-default-dim-mm-format))
           )
           ((equal cl :CM)
             (setf fs (sd-am-inq-default-dim-cm-format))
           )
           ((equal cl :KM)
             (setf fs (sd-am-inq-default-dim-km-format))
           )
           ((equal cl :INCHES)
             (setf fs (sd-am-inq-default-dim-inches-format))
           )
           ;; der Rest ist uninteressant
          ) ;; end cond

          ;; Nachkommastellen
          (setf li2 (sd-string-split fs "."))
          (if (equal (length li2) 1)
            (setf nk 0)
            ;; else
            (setf nk (length (second li2)))
          )

          ;;(display (format nil "fs = ~a" fs))
          ;;(display (format nil "nk = ~a" nk))
          (setf dvs (sd-num-to-string dim-val nk))
        )
      )

      dvs
     )
    )
    ;;---------------------------------------------------------------------
    ;; Bemassungswert in aktuellen Bemassungseinheiten
    (conv-to-units ( dim-val-mm )
     (let (cl dim-val)

       (setf cl (sd-am-inq-default-dim-main-length-unit))
       (setf dim-val dim-val-mm)
       (cond
        ((equal cl :CM)
           (setf  dim-val (* dim-val-mm 0.1))
        )
        ((equal cl :KM)
           (setf  dim-val (* dim-val-mm 0.001))
        )
        ((equal cl :INCHES)
           (setf  dim-val (/ dim-val-mm 25.4))
        )
        ;; der Rest ist uninteressant
       )

       dim-val
     )
    )
    ;;---------------------------------------------------------------------
    (get-inverse-matrix ( matrix )
     (let (m im)
      (setf m (K2::MAKE-MATRIX-3D :T0 0.0 :T1 0.0 :T2 0.0
                   :SCALE 1.0
                   :FLAG-1 0 :FLAG-2 0 :FLAG-3 0 :FLAG-4 0 :FLAG-5 0 :FLAG-6 0 
                   :A11 (float (aref matrix 0 0))
                   :A12 (float (aref matrix 0 1))
                   :A13 (float (aref matrix 0 2))
                   :A21 (float (aref matrix 1 0))
                   :A22 (float (aref matrix 1 1))
                   :A23 (float (aref matrix 1 2))
                   :A31 (float (aref matrix 2 0))
                   :A32 (float (aref matrix 2 1))
                   :A33 (float (aref matrix 2 2))
      
      ))

      (setf im (K2::INVERSE-TRANSFORMATION-3D m))

      im
     )
    )
    
    ;;---------------------------------------------------------------------
    ;; Bemassungsfunktion (Hauptfkt)
    (bemassen ()
     (let (v1 v2 view_part_id1 new-dim-val)

      ;;(display (format nil "p1 = ~a" p1))
      ;;(display (format nil "p2 = ~a" p2))

      ;; die beiden Views in denen die Punkte liegen
      (setf v1 (first (sd-call-cmds (get_selection
        :focus_type *sd-anno-view-seltype*
        :select p1))))
      (setf v2 (first (sd-call-cmds (get_selection
        :focus_type *sd-anno-view-seltype*
        :select p2))))

      (if (equal v1 v2)
        (progn
          (end-dim-position-feedback)
          (sd-display-error "Punkte liegen in der gleichen Ansicht. Benutzen Sie die Standardfunktionen aus dem Bemassen MenÏ")
        )
        ;; else
        (progn
          ;; die Bemassung temporaer im aktuellen Blatt erzeugen
          (sd-am-add-curr-info-attributes (list "TS-AM-BROKE-TMP-INFO"))
          (start-dim-position-feedback)
          (sd-execute-annotator-command :cmd (format nil 
            "~a,~a END" (gpntdocu_x p3) (gpntdocu_y p3)))
          (sd-am-change-curr-info-attribute "TS-AM-BROKE-TMP-INFO" "")

          ;; Bemassung in den VIEW Part kopieren
          (setf view_part_id1 (sd-am-inq-unique-name v1))
          (sd-execute-annotator-command :cmd (format nil
              "Ts_am_broke_dim_to_part '~a' 'TS-AM-BROKE-TMP-INFO' 'TS-AM-BROKE-INFO-DIM-CURR'  'TS-AM-BROKE-INFO-POINT' ~a"
               view_part_id1 (get-ri)))

          ;; die temp Bemassung nun loeschen
          (sd-execute-annotator-command :cmd 
             "DELETE GLOBAL INFOS 'TS-AM-BROKE-TMP-INFO' END")

          (setf dim_addr (sd-execute-annotator-function :fnc 
                (format nil "Ts_am_broke_get_dim_text_pointer '~a' 'TS-AM-BROKE-INFO-DIM-CURR'" view_part_id1)))
          ;;(display (format nil "dim_addr = <~a>" dim_addr))

          (when (> dim_addr 0)
           ;; muss auch so sein
           (progn
             (setf new-dim-val (get-dim-val v1 v2 dim_addr))
             (sd-execute-annotator-command :cmd (format nil
                "Ts_am_broke_edit_dim_text '~a' ~a '~a'" view_part_id1 dim_addr
                    new-dim-val))
           )
          )
          
          (sd-am-change-curr-info-attribute 
                "TS-AM-BROKE-INFO-DIM-CURR"
                "TS-AM-BROKE-INFO-DIM"
          )
        )
      ) ;; if


     )
    )
    ;;---------------------------------------------------------------------
   )
:ok-action
  '(setf x "nothing to do")
:cleanup-action
  '(progn
     (end-line-feedback)
     (sd-execute-annotator-command :cmd (format nil
        "EDIT_PART '~a'" akt_teil))
   )
)

;;***************************************************************************
;;     FUNCTIONS                                                            *
;;***************************************************************************

;;--------------------------------------------------------------------------*

;;--------------------------------------------------------------------------*
(defun ts-am-broke-check-valid-dim-point ( p )
 (let (ret)
  ;;(display "ts-am-broke-check-valid-dim-point")
  (if (sd-execute-annotator-function :fnc (format nil
       "Ts_am_broke_check_valid_dim_point ~a,~a" (gpntdocu_x p) (gpntdocu_y p)))
   (progn
    ;; selectiong the view 
    (setf v (sd-call-cmds (get_selection
        :focus_type *sd-anno-view-seltype*
        :select p)))
    ;;(display v)
    ;;  Tja : v wird leider nicht geliefert, falls Mittel od. Symmetriellinie
    ;         gewaehlt wurde
    (if v
      (setf ret :ok)
      (setf ret :error)
    )
   )
   ;; else
   (setf ret :error)
  )
  ;;(display ret)

  ret
 )
)


;;--------------------------------------------------------------------------*
;;     Funktion: ts-am-broke-get-sd-v-info                                           *
;;               Liefert Info SD_V einer Ansicht                            *
;;                                                                          *
;;     Parameter : ansicht                                                  *
;;                                                                          *
;;     Returnwert: Info SD_V                                                *
;;                                                                          *
;;  Schaumberger G.   01.03.1999                                            *
;;-------------------------------------------------------------------------*/
(defun ts-am-broke-get-sd-v-info ( ansicht )
 (let (me10_tnr info)
   (setf me10_tnr (sd-am-inq-unique-name ansicht))
   (setf info (sd-execute-annotator-function :fnc
         (format nil "Ts_am_broke_get_sd_v_ansicht '~a'" me10_tnr)))
   info
 )
)

;;--------------------------------------------------------------------------*
;;     Funktion: ts-am-broke-get-2d3d-matr                                           *
;;               Liefert Transformationsmatrix und Vektor                   *
;;                                                                          *
;;     Parameter : ansicht                                                  *
;;                                                                          *
;;     Returnwert: Liste mit                                                *
;;                                                                          *
;;               1) Transformationsmatrix                                   *
;;               2) Transformationsvektor                                   *
;;               3) Drehmittelpunkt bei gedrehten Ansichten                 *
;;               4) Drehwinkel bei gedrehten Ansichten  (od. 0.0)           *
;;                                                                          *
;;  Schaumberger G.   25.02.1999                                            *
;;                                                                          *
;;  Anderungsverzeichnis:                                                   *
;;   Version   |  Datum   |   Autor    |  Beschreibung                      *
;;             |          |            |                                    *
;;     8.01    |24.08.2000|Schaumberger| Ergaenzung fuer gedrehte Ansichten *
;;             |          |            |                                    *
;;             |          |            |                                    *
;;-------------------------------------------------------------------------*/
(defun ts-am-broke-get-2d3d-matr ( ansicht )
 (let (me10_tnr teil matr zk wl wls matrix t_vec v2 v1 transformationsvek
       rot_winkel rot_winkel_rad rot_mpkt)

   ;;(display "ts-get-2d3d-matr")
   (setf me10_tnr (sd-am-inq-unique-name ansicht))
   ;;(display me10_tnr)
   (setf matr (sd-execute-annotator-function :fnc
         (format nil "Ts_am_broke_get_view_matrix '~a'" me10_tnr)))

   (setf wls (sd-string-split matr " "))
   ;; auf Zahlen umwandeln
   (setf wl nil)
   (dolist (zk wls)
     (setf wl (append wl (list (read-from-string zk))))
   )

   (if (not (equal (length wl) 15))
     (progn
       (setf matrix nil)
       (setf transformationsvek nil)
       (setf rot_winkel_rad nil)
       (setf rot_mpkt nil)
     )
     ;; else
     (progn
       (setf matrix (make-array '(3 3) :initial-contents
            (list (list (nth 0 wl) (nth 1 wl) (nth 2 wl))
                  (list (nth 3 wl) (nth 4 wl) (nth 5 wl))
                  (list (nth 6 wl) (nth 7 wl) (nth 8 wl))
            ))
       )
       (setf t_vec (make-array 3 :initial-contents
                  (list (nth 9 wl) (nth 10 wl) (nth 11 wl)))
       )
       (setf v2    (make-array 3 :initial-contents
                  (list (nth 12 wl) (nth 13 wl) (nth 14 wl)))
       )
       ;;(display "matrix")
       ;;(display matrix)
       ;;(display (format nil "t_vec = ~a" t_vec))
       ;;(display (format nil "v2 = ~a" v2))

       (setf v1 (ts-am-broke-matmult-vec matrix t_vec))
       ;;(display (format nil "v1 = ~a" v1))


       (setf v1 (make-gpnt3d :x (aref v1 0) :y (aref v1 1) :z (aref v1 2)))
       (setf v2 (make-gpnt3d :x (aref v2 0) :y (aref v2 1) :z (aref v2 2)))
      
       ;;(display (format nil "v1 = ~a" v1))
       ;;(display (format nil "v2 = ~a" v2))
       
       (setf transformationsvek (sd-vec-subtract v2 v1))
       ;;(display (format nil "transformationsvek = ~a" transformationsvek))

       (setf rot_winkel (gpnt3d_z v2))
       (setf rot_mpkt (oli::make-gpnt2d :x (gpnt3d_x v2) :y (gpnt3d_y v2)))
       (setf rot_winkel_rad (/ (* rot_winkel pi) 180.0))

       ;;(display (format nil "rot_winkel = ~a" rot_winkel))
       ;;(display (format nil "rot_winkel_rad = ~a" rot_winkel_rad))
     )
   ) ;; if


  ;;(display "nach ts-get-2d3d-matr")
  (list matrix transformationsvek rot_winkel_rad rot_mpkt) ;; returnwert
 )
)

;; Ckeck on 2 Transformationsmatrizen. ident sind
(defun ts-am-broke-ident-2d3d-matr ( m1 m2 )
 (let (ret dim1_1 dim1_2 dim2_1 dim2_2 i j)

   (setf ret nil)
   (setf dim1_1 (array-dimension m1 0))
   (setf dim1_2 (array-dimension m1 1))
   (setf dim2_1 (array-dimension m2 0))
   (setf dim2_2 (array-dimension m2 1))
   (when (and (equal dim1_1 dim2_1)
              (equal dim1_2 dim2_2)
       )
     (progn
       (setf ret t)
       (dotimes (i dim1_1)
        (progn
         (dotimes (j dim1_2)
          (progn
           (when (> (abs (- (aref m1 i j) (aref m2 i j))) 0.00001)
             (setf ret nil)
           )
          )
         ) ;; dotimes j
        )
       ) ;; dotimes i
     )
   )

   ret
 )
)

;;--------------------------------------------------------------------------*
;;     Funktion: ts-am-broke-matmult-vec                                             *
;;               Matrix x Vektor                                            *
;;                                                                          *
;;     Parameter : matrix  ....    Matrix (muss 2-dimensional sein) !!!     *
;;                 vec     ....    Vektor (muss 1-dimensional sein)         *
;;                                                                          *
;;     Returnwert: Ergebnisvektor                                           *
;;                                                                          *
;;  Schaumberger G.   25.02.1999                                            *
;;-------------------------------------------------------------------------*/
(defun ts-am-broke-matmult-vec ( matrix vec )
 (let (dimension e-vec i li)

  (setf dimension (array-dimension matrix 0))
  (setf li nil)
  (dotimes (i dimension)
   (progn
     (setf erg 0.0)
     (dotimes (j (array-dimension matrix 1))
       (setf erg (+ erg (* (aref matrix i j) (aref vec j))))
     ) ;; dotimes
  
   (setf li (append li (list erg)))
     
   )
  ) ;; dotimes

  (setf e-vec (make-array (length li) :initial-contents li))
    

 e-vec ;; returnwert
 ) ;; let
)

;;***************************************************************************
;;     ME10 MACROS                                                          *
;;***************************************************************************

;;---------------------------------------------------------------------------
(defun ts-broke-cmd ( me10-cmd )
  (sd-execute-annotator-command :cmd me10-cmd)
)

(sd-execute-annotator-command :cmd (format nil
 "~a ~a ~a ~a ~a ~a"
 "DEFINE Ts_am_broke_get_curr_part"
 " INQ_PART '.'"
 " (DOCU_OPEN_CONNECTION_TO_SD)"
 " (DOCU_ADD_LINE_TO_SD (DOCU_CSTRING_TO_LSTRING (INQ 302)))"
 " (DOCU_CLOSE_CONNECTION_TO_SD)"
 "END_DEFINE"
))

(sd-execute-annotator-command :cmd (format nil
 "~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a"
 "DEFINE Ts_am_broke_check_valid_dim_point"
 "PARAMETER P"
 "LOCAL Ret"
 "LOCAL Err"
 " TRAP_ERROR"
 "   DIM_LINE P"
 " IF (CHECK_ERROR)"
 "   LET Ret 'nil'"
 "   LET Err ((ERROR_STR)+'XXXXXXXXXXXXXX')"
 "   IF ((SUBSTR Err 1 7) = 'Warning')"
 "      LET Ret 't'"
 "   END_IF"
 " ELSE"
 "   LET Ret 't'"
 " END_IF"
 " END"
 " (DOCU_OPEN_CONNECTION_TO_SD)"
 " (DOCU_ADD_LINE_TO_SD Ret)"
 " (DOCU_CLOSE_CONNECTION_TO_SD)"
 "END_DEFINE"
))

;;--------------------------------------------------------------------------
;; Bemassung im gewuenschten Teil duplizieren
(ts-broke-cmd "DEFINE Ts_am_broke_dim_to_part")
(ts-broke-cmd "PARAMETER Part_id")
(ts-broke-cmd "PARAMETER Inf")
(ts-broke-cmd "PARAMETER Info_add")
(ts-broke-cmd "PARAMETER Info_add_point")
(ts-broke-cmd "PARAMETER Richtung")
(ts-broke-cmd "LOCAL Pm")
(ts-broke-cmd "LOCAL P1")
(ts-broke-cmd "LOCAL P2")
 (ts-broke-cmd "INQ_PART '.'")
 (ts-broke-cmd "LET Ap (INQ 302)")
 (ts-broke-cmd "EDIT_PART Part_id")
 (ts-broke-cmd "TRAP_ERROR")
  (ts-broke-cmd "INQ_SELECTED_ELEM SELECT GLOBAL DIMENSIONS ALL")
     (ts-broke-cmd "AND GLOBAL INFOS inf CONFIRM END")
 (ts-broke-cmd "IF ((CHECK_ERROR=0) AND ((INQ 403)=DIM_LINE))")
    (ts-broke-cmd "LET Pm (INQ 101)")
    (ts-broke-cmd "LET P1 (INQ 106)")
    (ts-broke-cmd "LET P2 (INQ 107)")
    (ts-broke-cmd "TRAP_ERROR")
      (ts-broke-cmd "DIM_LINE P1")
    (ts-broke-cmd "IF (CHECK_ERROR<>0)")
      (ts-broke-cmd "Ts_am_broke_create_dummy_point P1 Info_add_point")
    (ts-broke-cmd "END_IF")
    (ts-broke-cmd "END")
    (ts-broke-cmd "TRAP_ERROR")
      (ts-broke-cmd "DIM_LINE P2")
    (ts-broke-cmd "IF (CHECK_ERROR<>0)")
      (ts-broke-cmd "Ts_am_broke_create_dummy_point P2 Info_add_point")
    (ts-broke-cmd "END_IF")
    (ts-broke-cmd "END")
    (ts-broke-cmd "ADD_CURRENT_INFO Info_add")
    (ts-broke-cmd "DIM_LINE Richtung P1 P2 Pm END")
    (ts-broke-cmd "CHANGE_CURRENT_INFO Info_add ''")
 (ts-broke-cmd "END_IF")
 (ts-broke-cmd "EDIT_PART Ap")
(ts-broke-cmd "END_DEFINE")

;;---------------------------------------------------------------------------
(sd-execute-annotator-command :cmd (format nil
 "~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a"
  "DEFINE Ts_am_broke_create_dummy_point"
  "PARAMETER P"
  "PARAMETER Info_add"
  "LOCAL F"
   "INQ_ENV 3"
   "LET F (INQ 201)"
   "ADD_CURRENT_INFO Info_add"
   "POINT BLACK P END"
   "CHANGE_CURRENT_INFO Info_add ''"
   "LINE RGB_COLOR F END"
  "END_DEFINE"
))
 
;;---------------------------------------------------------------------------
;; Bemassung : Addr abfragen   
(sd-execute-annotator-command :cmd (format nil
 "~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a"
  "DEFINE Ts_am_broke_get_dim_text_pointer"
  "PARAMETER Part_id"
  "PARAMETER Inf"
  "LOCAL Ap"
  "LOCAL Dp"
  " INQ_PART '.'"
  " LET Ap (INQ 302)"
  " EDIT_PART Part_id"
  " TRAP_ERROR"
  "  INQ_SELECTED_ELEM SELECT INFOS Inf CONFIRM END"
  " IF (CHECK_ERROR=0)"
  "   LET Dp (INQ 2)"
  " ELSE"
  "   LET Dp -1"
  " END_IF"
  " EDIT_PART Ap"
  " (DOCU_OPEN_CONNECTION_TO_SD)"
  " (DOCU_ADD_LINE_TO_SD (STR Dp))"
  " (DOCU_CLOSE_CONNECTION_TO_SD)"
  "END_DEFINE"
))

;;---------------------------------------------------------------------------
;; Bemassungswert aendern
(sd-execute-annotator-command :cmd (format nil
 "~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a ~a"
  "DEFINE Ts_am_broke_edit_dim_text"
  "PARAMETER Part_id"
  "PARAMETER Dim_addr"
  "PARAMETER New_val"
  "LOCAL Koo"
  "LOCAL Ap"
  " INQ_PART '.'"
  " LET Ap (INQ 302)"
  " EDIT_PART Part_id"
  " INQ_SELECTED_ELEM POINTER Dim_addr"
  " LET Koo ( INQ 101 )"
  " EDIT_DIM_TEXT Koo New_val '' END"
  " EDIT_PART Ap"
  "END_DEFINE"
))

;;{---------------------------------------------------------------------------}
;;{ Transformatonsmatrix und Vektor aus Info lesen                            }
(sd-execute-annotator-command :cmd (format nil
 "~a ~a ~a ~a ~a ~a ~a ~a ~a"
  "DEFINE Ts_am_broke_get_view_matrix"
  "PARAMETER Teilenr"
  "LOCAL ret_string"
    "Ts_broke_get_view_matrix_sd Teilenr"
    "LET ret_string (DOCU_CSTRING_TO_LSTRING Ts_broke_view_matrix_sd)"
    "(DOCU_OPEN_CONNECTION_TO_SD)"
    "(DOCU_ADD_LINE_TO_SD ret_string)"
    "(DOCU_CLOSE_CONNECTION_TO_SD)"
  "END_DEFINE"
))

(ts-broke-cmd "DEFINE Ts_broke_get_view_matrix_sd")
(ts-broke-cmd "PARAMETER Teilenr")
(ts-broke-cmd "LOCAL Akt_part")
(ts-broke-cmd "LOCAL Is")
(ts-broke-cmd "LOCAL L")
(ts-broke-cmd "LOCAL Posi")
(ts-broke-cmd "LOCAL Koord")
(ts-broke-cmd "INQ_PART '.'")
(ts-broke-cmd "LET Akt_part (INQ 302)")
(ts-broke-cmd "EDIT_PART Teilenr")
(ts-broke-cmd "INQ_PART '.'")
(ts-broke-cmd "LET Is (INQ 904)")
(ts-broke-cmd "LET V_vec ''")
(ts-broke-cmd "LET T_matr ''")
(ts-broke-cmd "WHILE (Is <> 'END-OF-LIST')")
  (ts-broke-cmd "LET L (LEN Is)")
  (ts-broke-cmd "IF ((L>5) AND ((SUBSTR Is 1 5) = 'SD_V:'))")
    (ts-broke-cmd "{ Verschiebungsvektor }")
    (ts-broke-cmd "LET Is (SUBSTR Is 6 (L-5))")
    (ts-broke-cmd "LET Posi (POS Is ':')")
    (ts-broke-cmd "LET Is (SUBSTR Is (Posi+1) ((LEN Is)-Posi))")
    (ts-broke-cmd "LET I 1")
    (ts-broke-cmd "WHILE (I<=3)")
      (ts-broke-cmd "Ts_broke_get_view_matrix_sd_lies_k ':'")
      (ts-broke-cmd "LET V_vec (V_vec +' '+Koord)")
      (ts-broke-cmd "LET I (I+1)")
    (ts-broke-cmd "END_WHILE")
  (ts-broke-cmd "END_IF")
  (ts-broke-cmd "IF ((L>10) AND ((SUBSTR Is 1 10) = 'SD_V3D_XF:'))")
    (ts-broke-cmd "LET Is (SUBSTR Is 11  (L-10))")
    (ts-broke-cmd "LET Posi (POS Is ':')")
    (ts-broke-cmd "LET Is (SUBSTR Is (Posi+1) ((LEN Is)-Posi))")
    (ts-broke-cmd "LET I 1")
    (ts-broke-cmd "WHILE (I<=8)")
      (ts-broke-cmd "Ts_broke_get_view_matrix_sd_lies_k ','")
      (ts-broke-cmd "LET T_matr (T_matr +' '+Koord)")
      (ts-broke-cmd "LET I (I+1)")
    (ts-broke-cmd "END_WHILE")
    (ts-broke-cmd "Ts_broke_get_view_matrix_sd_lies_k ' '")
    (ts-broke-cmd "LET T_matr (T_matr +' '+Koord)")
    (ts-broke-cmd "LET Is (Is+',')")
    (ts-broke-cmd "LET I 1")
    (ts-broke-cmd "WHILE (I<=3)")
      (ts-broke-cmd "Ts_broke_get_view_matrix_sd_lies_k ','")
      (ts-broke-cmd "LET T_matr (T_matr +' '+Koord)")
      (ts-broke-cmd "LET I (I+1)")
    (ts-broke-cmd "END_WHILE")
  (ts-broke-cmd "END_IF")
  (ts-broke-cmd "LET Is (INQ 905)")
(ts-broke-cmd "END_WHILE")
(ts-broke-cmd "LET Ts_broke_view_matrix_sd ((TRIM T_matr) + ' ' +(TRIM V_vec))")
(ts-broke-cmd "EDIT_PART Akt_part")
(ts-broke-cmd "END_DEFINE")

(ts-broke-cmd "DEFINE Ts_broke_get_view_matrix_sd_lies_k")
(ts-broke-cmd "PARAMETER Trz")
  (ts-broke-cmd "LOCAL Posi")
  (ts-broke-cmd "LET Posi (POS Is Trz)")
  (ts-broke-cmd "LET Koord (SUBSTR Is 1 (Posi-1))")
  (ts-broke-cmd "LET Is (SUBSTR Is (Posi+1) ((LEN Is)-Posi))")
(ts-broke-cmd "END_DEFINE")

;;{---------------------------------------------------------------------------}
(ts-broke-cmd "DEFINE Ts_am_broke_get_sd_v_ansicht")
(ts-broke-cmd "PARAMETER Teilenr")
(ts-broke-cmd "LOCAL ret_string")
  (ts-broke-cmd "Ts_broke_get_sd_v_ansicht Teilenr")
  (ts-broke-cmd "LET ret_string (DOCU_CSTRING_TO_LSTRING Ts_broke_sd_v_info)")
  (ts-broke-cmd "(DOCU_OPEN_CONNECTION_TO_SD)")
  (ts-broke-cmd "(DOCU_ADD_LINE_TO_SD ret_string)")
  (ts-broke-cmd "(DOCU_CLOSE_CONNECTION_TO_SD)")
(ts-broke-cmd "END_DEFINE")

;;---------------------------------------------------------------------------
(ts-broke-cmd "DEFINE Ts_broke_get_sd_v_ansicht")
(ts-broke-cmd "PARAMETER Teilenr")
(ts-broke-cmd "LOCAL Akt_part")
(ts-broke-cmd "LOCAL Is")
(ts-broke-cmd "INQ_PART '.'")
(ts-broke-cmd "LET Akt_part (INQ 302)")
(ts-broke-cmd "EDIT_PART Teilenr")
(ts-broke-cmd "LET Ts_broke_sd_v_info '' { INIT }")
(ts-broke-cmd "INQ_PART '.'")
(ts-broke-cmd "LET Is (INQ 904)")
(ts-broke-cmd "WHILE ((Is <> 'END-OF-LIST') AND (Ts_broke_sd_v_info=''))")
  (ts-broke-cmd "IF ( ((LEN Is)>5) AND ((SUBSTR Is 1 5) = 'SD_V:') )")
    (ts-broke-cmd "LET Ts_broke_sd_v_info Is")
  (ts-broke-cmd "END_IF")
  (ts-broke-cmd "LET Is (INQ 905)")
(ts-broke-cmd "END_WHILE")
(ts-broke-cmd "EDIT_PART Akt_part")
(ts-broke-cmd "END_DEFINE")

;;---------------------------------------------------------------------------
(ts-broke-cmd "DEFINE Ts_am_broke_get_points_in_view_parts")
(ts-broke-cmd "PARAMETER View_id1")
(ts-broke-cmd "PARAMETER View_id2")
(ts-broke-cmd "PARAMETER Dim_addr")
(ts-broke-cmd "LOCAL Ap")
(ts-broke-cmd "LOCAL P1")
(ts-broke-cmd "LOCAL P2")
(ts-broke-cmd "LOCAL Ret")
(ts-broke-cmd "  INQ_PART '.'")
(ts-broke-cmd "  LET Ap (INQ 302)")
(ts-broke-cmd "  LET Ret 'nil'")
(ts-broke-cmd "  LET P1 (PNT_XY 0 0)")
(ts-broke-cmd "  LET P2 (PNT_XY 0 0)")
(ts-broke-cmd "  EDIT_PART View_id1")
(ts-broke-cmd "  TRAP_ERROR")
(ts-broke-cmd "    INQ_SELECTED_ELEM POINTER Dim_addr")
(ts-broke-cmd "  IF (CHECK_ERROR=0)")
(ts-broke-cmd "    LET P1 (INQ 106)")
(ts-broke-cmd "    LET P2 (INQ 107)")
(ts-broke-cmd "    Ts_am_broke_map_pnt2top P2")
(ts-broke-cmd "    LET P2 Ts_map_pnt")
(ts-broke-cmd "    EDIT_PART View_id2")
(ts-broke-cmd "    Ts_am_broke_map_pnt2teil P2")
(ts-broke-cmd "    LET P2 Ts_map_pnt")
(ts-broke-cmd "    LET Ret 't'")
(ts-broke-cmd "  END_IF")
(ts-broke-cmd "  EDIT_PART Ap")
(ts-broke-cmd "  (DOCU_OPEN_CONNECTION_TO_SD)")
(ts-broke-cmd "  (DOCU_ADD_LINE_TO_SD '(list ')")
(ts-broke-cmd "  (DOCU_ADD_LINE_TO_SD (Ret + ' '))")
(ts-broke-cmd "  (DOCU_ADD_LINE_TO_SD ('(oli::make-gpnt2d :x '+(STR (X_OF P1))+' :y '+(STR (Y_OF P1))+') '))")
(ts-broke-cmd "  (DOCU_ADD_LINE_TO_SD ('(oli::make-gpnt2d :x '+(STR (X_OF P2))+' :y '+(STR (Y_OF P2))+') '))")
(ts-broke-cmd "  (DOCU_ADD_LINE_TO_SD ')')")
(ts-broke-cmd "  (DOCU_CLOSE_CONNECTION_TO_SD)")
(ts-broke-cmd "END_DEFINE")

;;---------------------------------------------------------------------------
;; Liefert Bemassungspunkte in der View View_id1
(ts-broke-cmd "DEFINE Ts_am_broke_get_dim_points_in_view_parts")
(ts-broke-cmd "PARAMETER View_id1")
(ts-broke-cmd "PARAMETER View_id2")
(ts-broke-cmd "PARAMETER Dim_addr")
(ts-broke-cmd "LOCAL Ap")
(ts-broke-cmd "LOCAL P1")
(ts-broke-cmd "LOCAL P2")
(ts-broke-cmd "LOCAL Ret")
(ts-broke-cmd "  INQ_PART '.'")
(ts-broke-cmd "  LET Ap (INQ 302)")
(ts-broke-cmd "  LET Ret 'nil'")
(ts-broke-cmd "  LET P1 (PNT_XY 0 0)")
(ts-broke-cmd "  LET P2 (PNT_XY 0 0)")
(ts-broke-cmd "  EDIT_PART View_id1")
(ts-broke-cmd "  TRAP_ERROR")
(ts-broke-cmd "    INQ_SELECTED_ELEM POINTER Dim_addr")
(ts-broke-cmd "  IF (CHECK_ERROR=0)")
(ts-broke-cmd "    LET P1 (INQ 102)")
(ts-broke-cmd "    LET P2 (INQ 103)")
;;(ts-broke-cmd "    Ts_am_broke_map_pnt2top P2")
;;(ts-broke-cmd "    LET P2 Ts_map_pnt")
;;(ts-broke-cmd "    EDIT_PART View_id2")
;;(ts-broke-cmd "    Ts_am_broke_map_pnt2teil P2")
;;(ts-broke-cmd "    LET P2 Ts_map_pnt")
(ts-broke-cmd "    LET Ret 't'")
(ts-broke-cmd "  END_IF")
(ts-broke-cmd "  EDIT_PART Ap")
(ts-broke-cmd "  (DOCU_OPEN_CONNECTION_TO_SD)")
(ts-broke-cmd "  (DOCU_ADD_LINE_TO_SD '(list ')")
(ts-broke-cmd "  (DOCU_ADD_LINE_TO_SD (Ret + ' '))")
(ts-broke-cmd "  (DOCU_ADD_LINE_TO_SD ('(oli::make-gpnt2d :x '+(STR (X_OF P1))+' :y '+(STR (Y_OF P1))+') '))")
(ts-broke-cmd "  (DOCU_ADD_LINE_TO_SD ('(oli::make-gpnt2d :x '+(STR (X_OF P2))+' :y '+(STR (Y_OF P2))+') '))")
(ts-broke-cmd "  (DOCU_ADD_LINE_TO_SD ')')")
(ts-broke-cmd "  (DOCU_CLOSE_CONNECTION_TO_SD)")
(ts-broke-cmd "END_DEFINE")

;;(*-------------------------------------------------------------------------*)
;;(* Umrechnen von Punkt in lokalem Koord-System (akt. Part) zu Punkt bezgl. *)
;;(* Top-Part (Koord. Sys von Top-Part)                                      *)
;;(*                                                                         *)
;;(* Pirklbauer Alfred:                  2.5.1995                            *)
;;(*                                           :                             *)
;;(* Eingabe: Local_pnt  ...Punkt bzgl. Koord.Sys von akt. Teiles            *)
;;(* Ausgabe: ts_map_pnt ...Punkt bzgl  Koord.Sys des Top-Parts              *)
;;(*                                           :                             *)
;;(* bekannte Probleme:  Umrechnung funktioniert bei bewegtem Zeichnungs-    *)
;;(*                     ursprung nicht                                      *)
;;(*                                                                         *)
;;(* -> vor Transformation  den Befehl     CS_REF_PT 0,0     absetzen        *)
;;(*                                                                         *)
;;(*-------------------------------------------------------------------------*)

(ts-broke-cmd "DEFINE Ts_am_broke_map_pnt2top")
(ts-broke-cmd "  PARAMETER Local_pnt")

(ts-broke-cmd "  local local_scale")
(ts-broke-cmd "  local global_scale")
(ts-broke-cmd "  local trans_vec")
(ts-broke-cmd "  local glob_trans_vec")
(ts-broke-cmd "  local akt_part")
(ts-broke-cmd "  LOCAL Lf")

(ts-broke-cmd "  INQ_ENV 6")
(ts-broke-cmd "  LET Lf (INQ 2)")

(ts-broke-cmd "  INQ_ENV 7")
(ts-broke-cmd "  LET Local_scale (INQ 4)")
(ts-broke-cmd "  LET Trans_vec (INQ 105)") ;; (* Versatz v. lokalem zu globalem Koord.Syst *)
                                           ;; (* in Einheiten des glob. Koord.Sys          *)

(ts-broke-cmd "  LET Trans_vec (Trans_vec / Lf)") ;; { Scha 25.7.97 }

(ts-broke-cmd "  LET akt_part (INQ 302)")  ;;   (* Eindeutiger Teilename                     *)

(ts-broke-cmd "  EDIT_PART TOP")
(ts-broke-cmd "  INQ_ENV 7")
(ts-broke-cmd "  LET Global_scale (INQ 4)")
(ts-broke-cmd "  LET Glob_trans_vec (INQ 105)") ;; (* Versatz v. Top-Part zu globalem Koord.Syst *)

(ts-broke-cmd "  LET Glob_trans_vec (Glob_trans_vec / Lf)") ;;  { Scha 25.7.97 }

(ts-broke-cmd "  EDIT_PART ('~'+akt_part)")

(ts-broke-cmd "  LET Ts_map_pnt ((Local_pnt*Local_scale+Trans_vec-Glob_trans_vec)/Global_scale)") ;;(* Punkt bzgl. Top-Part Koord.System *)
(ts-broke-cmd "END_DEFINE")

;;(*-------------------------------------------------------------------------*)
;;(* Top-Part (Koord. Sys von Top-Part)                                      *)
;;(*                                                                         *)
;;(* Schaumberger G.                    16.5.1995                            *)
;;(*                                           :                             *)
;;(* Eingabe: Top_pnt    ...Punkt bzgl. Koord.Sys von Top- Partes            *)
;;
;;(* Ausgabe: ts_map_pnt ...Punkt bzgl  Koord.Sys des Akt-Teiles             *)
;;(*                                           :                             *)
;;(* bekannte Probleme:  Umrechnung funktioniert bei bewegtem Zeichnungs-    *)
;;(*                     ursprung nicht                                      *)
;;(*                                                                         *)
;;(* -> vor Transformation  den Befehl     CS_REF_PT 0,0     absetzen        *)
;;(*                                                                         *)
;;(*-------------------------------------------------------------------------*)

(ts-broke-cmd "DEFINE Ts_am_broke_map_pnt2teil")
(ts-broke-cmd "   PARAMETER Top_pnt")

(ts-broke-cmd "  LOCAL P2")
(ts-broke-cmd "  LOCAL P3")
(ts-broke-cmd "  LOCAL P4")
(ts-broke-cmd "  LOCAL Lf")
(ts-broke-cmd "  LOCAL akt_part")

(ts-broke-cmd "  INQ_ENV 6")
(ts-broke-cmd "  LET Lf (INQ 2)")

(ts-broke-cmd "  INQ_ENV 7")
(ts-broke-cmd "  LET Local_scale (INQ 4)")
(ts-broke-cmd "  LET Trans_vec (INQ 105)") ;;    (* Versatz v. lokalem zu globalem Koord.Syst *)
                                           ;;    (* in Einheiten des glob. Koord.Sys          *)

(ts-broke-cmd "  LET Trans_vec (Trans_vec / Lf)") ;;  { Scha 25.7.97 }

(ts-broke-cmd "  LET akt_part (INQ 302)") ;;     (* Eindeutiger Teilename                     *)

(ts-broke-cmd "  EDIT_PART TOP")
(ts-broke-cmd "  INQ_ENV 7")
(ts-broke-cmd "  LET Global_scale (INQ 4)")
(ts-broke-cmd "  LET Glob_trans_vec (INQ 105)") ;;  (* Versatz v. Top-Part zu globalem Koord.Syst *)

(ts-broke-cmd "  LET Glob_trans_vec (Glob_trans_vec / Lf)") ;;  { Scha 25.7.97 }

(ts-broke-cmd "  EDIT_PART ('~'+akt_part)")

(ts-broke-cmd "  LET P2 (Top_pnt * Global_scale)")
(ts-broke-cmd "  LET P3 (P2 + Glob_trans_vec)") ;;  { im Globalen }
(ts-broke-cmd "  LET P4 (P3 - Trans_vec)")
(ts-broke-cmd "  LET Ts_map_pnt (P4/ Local_scale)")

(ts-broke-cmd "END_DEFINE")