(vl-load-com)
(defun c:VannesPointTopoCoordonnées (/ ANNEELENGTH ANNEEBONNELENGTH SELECTION1 CARACTERISTIQUELISTE SELECTION2 NUMBERENTITE1 ENTITELISTE1 ENTITE1 POINT CARACTERISTIQUE BLOC NUMBERENTITE2 ENTITE2)

  (setq FICHIERERREUR (open "C:/Acad fichiers/Intégrateur/Erreur.txt" "w"))

  (while (/= ANNEELENGTH 2)
	(progn
	  (princ (strcat "\n"))
	  (setq ANNEE (getstring "Saisir l'année des points à traiter (2 caractères): " ))
	  (setq ANNEELENGTH (strlen ANNEE))
	  )
	)

  (initget (+ 2 3))
  (setq IMPRECISIONPLANI (getreal "Définir l'imprécision planimétrique (cm) tolérée: "))
  (setq IMPRECISIONPLANI (/ IMPRECISIONPLANI 100))
  (setq IMPRECISIONALTI (getreal "Définir l'imprécision altimétrique (cm) tolérée: "))
  (setq IMPRECISIONALTI (/ IMPRECISIONALTI 100))

;;;  (setq IMPRECISIONPLANI 0.05)
;;;  (setq IMPRECISIONALTI 0.04)
  (setq MESSAGE (strcat "Le matricule du point doit être identique."
		        "\nL'imprécision des points en plani ne doit pas dépasser: " (rtos IMPRECISIONPLANI 2 3)"m" 
			"\nL'imprécision des points en alti ne doit pas dépasser: " (rtos IMPRECISIONALTI 2 3)"m"
			"\nLa liste des erreurs sera éditée dans le fichier C:/Acad fichiers/Intégrateur/Erreur.txt"))
  (alert MESSAGE)
  
  (setq TOPOJISANNEE (strcat "TOPOJIS" ANNEE))
  (setq TOPOJISANNEECACHE (strcat "TOPOJIS" ANNEE))
  (setq TOPOJISANNEECACHE (strcat TOPOJISANNEECACHE "-CACHE"))
  (setq TOPOJISANNEETOPOJISANNEECACHE (strcat TOPOJISANNEE ","))
  (setq TOPOJISANNEETOPOJISANNEECACHE (strcat TOPOJISANNEETOPOJISANNEECACHE TOPOJISANNEECACHE))

  (setq SELECTION1 (ssget "X" (list (cons 0 "INSERT") (cons 8 "TOPOJISORIGINE") )))

  (princ (strcat "\nSélectionner la zone à traiter:  "))            
  (setq SELECTION2 (ssget (list (cons 0 "INSERT") (cons 2 "TCPOINT") (cons 8 TOPOJISANNEETOPOJISANNEECACHE))))

   (setq LISTE nil)
   (if SELECTION1                                      
   (progn
      (setq NUMBERENTITE1 (sslength SELECTION1))            
      (setq I 0)
      (setq J 0)
      (while (< I NUMBERENTITE1)                         
         (setq ENTITE1 (ssname SELECTION1 I))               
         (setq ENTITELISTE1 (entget ENTITE1))                  
         (setq I (+ I 1))                    
         (setq POINT1 (cdr (assoc 10 ENTITELISTE1)))
         (setq BLOC1 (cdr (assoc 2 ENTITELISTE1)))          
	 (setq ENTITEATTRIB1 (entnext ENTITE1))
   	 (setq ENTITEATTRIBLISTE1 (entget ENTITEATTRIB1))
	 (while (/= (cdr (assoc 0 ENTITEATTRIBLISTE1)) "SEQEND")
	      (if (= "MAT" (cdr (assoc 2 ENTITEATTRIBLISTE1)))
	          (progn
 	          (setq MATRICULE1 (cdr (assoc 1 ENTITEATTRIBLISTE1)))
		  ))
	      (if (= "ALT" (cdr (assoc 2 ENTITEATTRIBLISTE1)))
	          (progn
 	          (setq ALTITUDE1 (cdr (assoc 1 ENTITEATTRIBLISTE1)))
		  ))
	       
              (setq ENTITEATTRIB1 (entnext ENTITEATTRIB1))
              (setq ENTITEATTRIBLISTE1 (entget ENTITEATTRIB1))
	 )
         (setq X (rtos (car POINT1) 2 4))                                       
	 (setq Y (rtos (cadr POINT1) 2 4))                                       
         (setq X (atof X))
         (setq Y (atof Y))
	 (setq POINT1 (list X Y 0.0))
	 (setq POINT1 (list I POINT1 MATRICULE1 ALTITUDE1))
         (setq LISTE (cons POINT1 LISTE))
      )
     )
     )
  (if SELECTION2                                      
   (progn
      (setq NUMBERENTITE2 (sslength SELECTION2))            
      (setq L 0)
      (setq J 0)
      (while (< J NUMBERENTITE2)                         
         (setq ENTITE2 (ssname SELECTION2 J))               
         (setq ENTITELISTE2 (entget ENTITE2))                  
         (setq J (+ J 1))                    
         (setq CALQUE2 (cdr (assoc 8 ENTITELISTE2)))          
         (setq POINT2 (cdr (assoc 10 ENTITELISTE2)))          
	 (setq MAINTIEN2 (cdr (assoc 5 ENTITELISTE2)))
         (setq BLOC2 (cdr (assoc 2 ENTITELISTE2)))          
	 (setq ENTITEATTRIB2 (entnext ENTITE2))
   	 (setq ENTITEATTRIBLISTE2 (entget ENTITEATTRIB2))
	 (while (/= (cdr (assoc 0 ENTITEATTRIBLISTE2)) "SEQEND")
	      (if (= "MAT" (cdr (assoc 2 ENTITEATTRIBLISTE2)))
	          (progn
 	          (setq MATRICULE2 (cdr (assoc 1 ENTITEATTRIBLISTE2)))
		  ))
	      (if (= "ALT" (cdr (assoc 2 ENTITEATTRIBLISTE2)))
	          (progn
 	          (setq ALTITUDE2 (cdr (assoc 1 ENTITEATTRIBLISTE2)))
		  (setq ALTITUDE2REAL (atof ALTITUDE2))
		  ))
	       
              (setq ENTITEATTRIB2 (entnext ENTITEATTRIB2))
              (setq ENTITEATTRIBLISTE2 (entget ENTITEATTRIB2))
	 )
         (setq LISTENUMBER (length LISTE))
	 (setq K 1)
	 (while (<= K LISTENUMBER)
	   (setq POINTMATRICULEALTITUDE1 (cdr (assoc K LISTE)))
	   (setq POINT1 (nth 0 POINTMATRICULEALTITUDE1))
	   (setq MATRICULE1 (nth 1 POINTMATRICULEALTITUDE1))
	   (setq ALTITUDE1 (nth 2 POINTMATRICULEALTITUDE1))
	   (setq ALTITUDE1REAL (atof ALTITUDE1))
	   (setq DISTPLANI (distance POINT1 POINT2))
	   (setq DISTALTI (- ALTITUDE1REAL ALTITUDE2REAL))
	   (if (= ALTITUDE2 "") (setq DISTALTI 0))
	   (if (< DISTALTI 0) (setq DISTALTI (* DISTALTI -1)))
	   (if (and (and (< DISTPLANI IMPRECISIONPLANI) (> DISTALTI IMPRECISIONALTI)) (= MATRICULE1 MATRICULE2))
	     (progn
;;;	       (setq POINT3 (polar POINT2 (- (/ PI 1.3333)) 4))
;;;	       (setq POINT4 (polar POINT2 (/ PI 4) 4))
;;;	       (command "ZOOM" "F" POINT3 POINT4)
	       (write-line (strcat MAINTIEN2 " Le point "MATRICULE2" Z="ALTITUDE2" dépasse l'imprécision en altimétrie (" (rtos IMPRECISIONALTI 2 3)"m) de "(rtos DISTALTI 2 3)"m. Le point sera modifié en planimétrie mais pas en altimétrie" ) FICHIERERREUR)
;;;	       (setq MESSAGE (strcat "Le point "MATRICULE1" Z="ALTITUDE1" dépasse l'imprécision en altimétrie: " (rtos IMPRECISIONALTI 2 3)" de "(rtos DISTALTI 2 3)" cm. Le point sera modifié en planimétrie mais pas en altimétrie"))
;;;	       (alert MESSAGE)
	       ))
	   (if (and (> DISTPLANI IMPRECISIONPLANI) (= MATRICULE1 MATRICULE2))
	     (progn
;;;	       (setq POINT3 (polar POINT2 (- (/ PI 1.3333)) 4))
;;;	       (setq POINT4 (polar POINT2 (/ PI 4) 4))
;;;	       (command "ZOOM" "F" POINT3 POINT4)
	       (write-line (strcat MAINTIEN2 " Le point "MATRICULE2" dépasse l'imprécision en planimétrie (" (rtos IMPRECISIONPLANI 2 3)"m) de "(rtos DISTPLANI 2 3)"m. Le point ne sera pas modifié en planimétrie et en altimétrie" ) FICHIERERREUR)
;;;	       (setq MESSAGE (strcat "Le point "MATRICULE1" dépasse l'imprécision en planimétrie: " (rtos IMPRECISIONPLANI 2 3)" de "(rtos DISTPLANI 2 3)" cm. Le point ne sera pas modifié en planimétrie et en altimétrie"))
;;;	       (alert MESSAGE)
	       ))
	   (if (and (< DISTPLANI IMPRECISIONPLANI) (= MATRICULE1 MATRICULE2))
	     (progn
		 (setq ENTITEATTRIB2 (entnext ENTITE2))
	   	 (setq ENTITEATTRIBLISTE2 (entget ENTITEATTRIB2))
		 (while (/= (cdr (assoc 0 ENTITEATTRIBLISTE2)) "SEQEND")
		      (if (and (and (= "ALT" (cdr (assoc 2 ENTITEATTRIBLISTE2))) (/= ALTITUDE2 "")) (<= DISTALTI IMPRECISIONALTI))
		          (progn
			    (setq ENTITEATTRIBLISTE2 (subst (cons 1 ALTITUDE1) (assoc 1 ENTITEATTRIBLISTE2) ENTITEATTRIBLISTE2))
			    (entmod ENTITEATTRIBLISTE2)	       
			  ))
		       
	              (setq ENTITEATTRIB2 (entnext ENTITEATTRIB2))
	              (setq ENTITEATTRIBLISTE2 (entget ENTITEATTRIB2))
		 )
	                (setq ENTITELISTE2 (subst (cons 10 POINT1) (assoc 10 ENTITELISTE2) ENTITELISTE2))
	                (entmod ENTITELISTE2)	       
                        (setq L (+ L 1))                    
	                (princ (strcat "\nNombre: "(itoa L)" Bloc " BLOC2 " , X=" (rtos (nth 0 POINT2) 2 2) "  Y=" (rtos (nth 1 POINT2) 2 2)))
			))
	     
	   (setq K (+ K 1))
	   )
      )
     )
     )
   (setq shell (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application")) 
   (vlax-invoke-method shell 'OPEN "C:\\Acad fichiers\\Intégrateur\\Erreur.txt") 
   (vlax-release-object shell) 
   (princ)
   )