Les fonctions:3DR1.LSP

;************************************************************************
;* [CMFAO] AME 6602 ACQUISITION DES DONNÉES SPATIALES                   *
;* [GRCAO] Claude Parisel                                               *
;* Mars 1999                                                            *
;************************************************************************
;3DR1
; calcul d'un point dans l'espace à partir de ses coordonnées dans 2 photos
; m1    matrice de pers de la 1ère photo
; m2    matrice de pers de la 2ème photo
; p1    point dans la 1ère photo [x1 y1]
; p2    point dans la 2ème photo [x2 y2]
;--------------------------------------------------------------------------
; Retour:
; point dans l'espace en format cartésien (x y z)
;--------------------------------------------------------------------------
(defun 3dr1 (m1 m2 p1 p2 / i j i1 j1 i2 j2 ma mb mc md me mx my)

  ;trouver le plan de projection de m1
  ;-----------------------------------
  (setq i1 0)
  (setq j 1)
  (while
    (<= j 3)
      (setq i 1)
      (while
        (<= i 4)
        (if
          (/= (mat-rec m1 i j) 0.0)
          (setq i 9)
        )
        (setq i (+ i 1))
      )
      (if
        (< i 9)
        (progn
          (cond
            (
              (= j 1)
              (setq i1 2)
              (setq i2 3)
            )
            (
              (= j 2)
              (setq i1 1)
              (setq i2 3)
            )
            (
              (= j 3)
              (setq i1 1)
              (setq i2 2)
            )
          )
          (setq j 3)
        )
      )
    (setq j (+ j 1))
  )
  (if (= i1 0)(print "m1 n'est pas une matrice de projection"))

  ;trouver le plan de projection de m2
  ;-----------------------------------
  (setq mx (mat-0 3 1))
  (setq j1 0)
  (setq j 1)
  (while
    (<= j 3)
      (setq i 1)
      (while
        (<= i 4)
        (if
          (/= (mat-rec m2 i j) 0.0)
          (setq i 9)
        )
        (setq i (+ i 1))
      )
      (if
        (< i 9)
        (progn
          (cond
            (
              (= j 1)
              (setq j1 2)
              (setq j2 3)
            )
            (
              (= j 2)
              (setq j1 1)
              (setq j2 3)
            )
            (
              (= j 3)
              (setq j1 1)
              (setq j2 2)
            )
          )
          (setq j 3)
        )
      )
    (setq j (+ j 1))
  )
  (if (= j1 0)(print "m2 n'est pas une matrice de projection"))

  ;calcul de ma
  ;------------------------
  (setq ma (mat-0 4 3))
  (setq i 1)
  (while
    (<=  i 3)
    (setq ma (mat-edit ma 1 i (- (mat-rec m1 i i1)(* (mat-rec m1 i 4)(car p1)))))
    (setq ma (mat-edit ma 2 i (- (mat-rec m1 i i2)(* (mat-rec m1 i 4)(cadr p1)))))
    (setq ma (mat-edit ma 3 i (- (mat-rec m2 i j1)(* (mat-rec m2 i 4)(car p2)))))
    (setq ma (mat-edit ma 4 i (- (mat-rec m2 i j2)(* (mat-rec m2 i 4)(cadr p2)))))
    (setq i (+ i 1))
  )

  ;calcul de mb
  ;------------------------
  (setq mb (mat-0 4 1))
  (setq mb (mat-edit mb 1 1 (- (* (mat-rec m1 4 4)(car p1))(mat-rec m1 4 i1))))
  (setq mb (mat-edit mb 2 1 (- (* (mat-rec m1 4 4)(cadr p1))(mat-rec m1 4 i2))))
  (setq mb (mat-edit mb 3 1 (- (* (mat-rec m2 4 4)(car p2))(mat-rec m2 4 j1))))
  (setq mb (mat-edit mb 4 1 (- (* (mat-rec m2 4 4)(cadr p2))(mat-rec m2 4 j2))))

  ;calcul de mc md me my mx
  ;------------------------
  (setq mc (mat-tpose ma))
  (setq md (mat-mul mc ma))
  (setq me (mat-inv md))
  (setq my (mat-mul mc mb))
  (setq mx (mat-mul me my))

  ;retour du point calculé format cartésien
  ;----------------------------------------
  (list (mat-rec mx 1 1)(mat-rec mx 2 1)(mat-rec mx 3 1))
)
;-----------------------------------------------------------------------