;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Tool to transfer, export and import Surface Elevation Analysis data   ;;;
;;; for Civil 3D 2008, 2009, 2010                		                          ;;;
;;; Update 26.07.07 - V1.0 write error fixed, DWGPREFIX for paths  ;;;
;;; Update 02.08.07.  connecttocivil added                        ;;;
;;; Update 30.02.08   compatible with Civil 2009                             ;;;
;;; Update 11.11.09   compatible with Civil 2010  CZ(XANADU,cz)                       ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Routine to transfer Civil 3D surface elevation analysis data          ;;;
;;; between surfaces in the same drawing                                  ;;;
;;; Routine to export Civil 3D surface elevation analysis data            ;;;
;;; into a text file  (Tab-delimited)                                     ;;;
;;; Routine to import Civil 3D surface elevation analysis data            ;;;
;;; from a text file  							  ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; tested with Civil 3D 2008, 2009, 2010                                            ;;;
;;; Commands to call: TransferElevations                                  ;;;
;;;         ExportElevations und                             		  ;;;
;;;         ImportElevations                                              ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; True Color and Color book colors are replaced by index colors         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(vl-load-com)
(defun connecttocivil ( /  AECCOBJ aecstring)
  (setq aecstring
	(cond
	  ((= (atof (getvar "acadver")) 16.2) "AeccXUiLand.AeccApplication.3.0"); 2006
	  ((= (atof (getvar "acadver")) 17.0) "AeccXUiLand.AeccApplication.4.0"); 2007
	  ((= (atof (getvar "acadver")) 17.1) "AeccXUiLand.AeccApplication.5.0"); 2008
	  ; single new line of Code for 2009
	  ((= (atof (getvar "acadver")) 17.2) "AeccXUiLand.AeccApplication.6.0"); 2009
	  ((= (atof (getvar "acadver")) 18.0) "AeccXUiLand.AeccApplication.7.0"); 2010
	  ('T "AeccXUiLand.AeccApplication")
        )
   )
   (if
     (vl-catch-all-error-p
      (setq AeccObj
      (vl-catch-all-apply
         'vla-getinterfaceobject
	 (list (vlax-get-acad-object) aecstring) ; connect to Civil 200x
      )
      )
     )
     NIL
     AeccObj
   )
)

(defun C:TransferElevations ( / ALLREGIONS AECCOBJ CNT DGMENTENTITY SSDGMS )
  (Prompt "\nPřenos nastavení dat povrchové analýzy (pro 2010-Xanadu)")
  (if (not (setq AeccObj (connecttocivil)))
    (progn
      (prompt "\nCivil 3D není k dipozici!")
      (exit)
    )
  )    
  (If (and (setq dgmententity (car (entsel "\nVyberte zdrojový povrch:")))
	   (= "AECC_TIN_SURFACE" (cdr (assoc 0 (entget dgmententity))))
      )
    (if (Setq AllRegions (GETTINDATA dgmententity))
      (progn
        (prompt "Vyberte cílový povrch:")
        (if (setq ssDGMS (SSGET (list (cons 0 "AECC_TIN_SURFACE"))))
	  (progn
	    (setq cnt (sslength ssDGMS))
	    (while (>= (setq cnt (1- cnt)) 0)
	      (PutTINDATA (ssname ssDGMs cnt)  AllRegions)
	    )
	  )
        )
      )
      ;else
      (Prompt "\nPovrch neobsahuje žádná data povrchové analýzy.")
    )
    (Prompt "\nNebyl vybrán žádný povrch.")
  )
  (prin1)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:ExportElevations ( / ALLREGIONS CNT DGMENTENTITY SSDGMS fdata dimz file)
  (Prompt "\nExport nastavení dat povrchové analýzy (pro 2010-Xanadu)")

  (If (and (setq dgmententity (car (entsel "\nVyberte zdrojový povrch:")))
	   (= "AECC_TIN_SURFACE" (cdr (assoc 0 (entget dgmententity))))
	   (setq fdata (getfiled "Určete soubor exportu dat povrchové analýzy:"
				 (strcat (getvar "dwgprefix")(getvar "dwgname"))
				 "txt"
				 1
		       )
	   )
      )
    (progn
      (setq file (open fdata "w"))
      (Write-line "Color\tMin. Elev\tMax. Elev" file)
      ; Daten müssen MÜSSEN mit Nachkommastellen exportiert werden
      (setq dimz (getvar "dimzin"))
      (setvar "dimzin" 2)
      (foreach region (setq regiondata (GETTINDATA dgmententity))
	(write-line (strcat (itoa (car   region)) ; Color
			    "\t"
			    (rtos (cadr  region) 2 3) ; MinimumElevation
			    "\t"
			    (rtos (caddr region) 2 3) ; MaximumElevation
		    )
	            file
	)
      )
      (setvar "dimzin" dimz)
      (close file)
      (if (not regiondata)
	(prompt "\nPovrch neobsahuje žádná data povrchové analýzy!")
        (prompt "Export dokončen.")
      )
    )
    (Prompt "\nNebyl vybrán žádný povrch.")
  )
  (prin1)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:ImportElevations ( / ALLREGIONS CNT DGMENTENTITY SSDGMS fdata file fline)
  (Prompt "\nImport nastavení dat povrchové analýzy (pro 2010-Xanadu)")
  (if (not (connecttoCivil))
    (progn
      (prompt "Civil 3D není k dipozici!")
      (exit)
    )
  )    
    
  (If (and (setq dgmententity (car (entsel "\nVyberte cílový povrch:")))
	   (= "AECC_TIN_SURFACE" (cdr (assoc 0 (entget dgmententity))))
	   (setq fdata (getfiled "Určete soubor importu dat povrchové analýzy:"
				 (strcat (getvar "dwgprefix")(getvar "dwgname"))
				 "txt"
				 0
		       )
	   )
      )
    (progn
      (setq file (open fdata "r"))
      (read-line file)
      (while (setq fline (read-line file))
	(setq region (read (strcat "(" fline ")"))
	      allRegions (cons region allRegions)
	)
      )
      (close file)
      (if (RegionDataok? (reverse AllRegions))
        (PutTINDATA dgmententity  (reverse AllRegions))
	(alert "Soubor obsahuje neplatná data! Import selhal.")
      )
      (prompt " hotovo.")

    )
    (Prompt "\nNebyl vybrán žádný povrch.")
  )
  (prin1)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun RegionDataok? (AllRegions)
  (setq cnt 0
	ok 'T
  )
  (repeat (length allRegions)
    (if (> (cadr (nth cnt allRegions)) (caddr (nth cnt allRegions)))
      (progn
	 (Prompt (strcat "\nProblém: Data v řádku " (itoa (1+ cnt)) " jsou neplatná! Min > Max.") )
	 (setq ok nil)
      )
    )
    (Cond
      ((= cnt 0) 'T)
      ((= (cadr (nth cnt allRegions)) (caddr (nth (1- cnt) allRegions))) 'T)
      ((> (cadr (nth cnt allRegions)) (caddr (nth (1- cnt) allRegions)))
       (Prompt (strcat "\nUpozornění: Mezera v datech na řádku " (itoa (1+ cnt))
		       "  Max < Min následujícího řádku."))
      )
      ((< (cadr (nth cnt allRegions)) (caddr (nth (1- cnt) allRegions)))
       (Prompt (strcat "\nProblém: Překryv v datech na řádku "
		       (itoa (1+ cnt)) "  Max > Min následujícího řádku."))
       (setq ok nil)
      )
      ('T 'T)
    )
    (Setq cnt (1+ cnt))
  )
  (if (not allRegions) nil ok); empty list?

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GETTINDATA (dgmententity /
		   AllRegions DGMOBJECT ELEVATIONREGIONS REGIONLIST
		   SURFACEANALYSIS SURFACEANALYSISELEVATION )
  (setq DGMObject (vlax-ename->vla-object DGMententity))
  (setq SurfaceAnalysis (vlax-get-property DGMObject "SurfaceAnalysis"))
  (setq SurfaceAnalysisElevation (vlax-get-property SurfaceAnalysis "ElevationAnalysis"))
  
  (setq ElevationRegions (vlax-get-property SurfaceAnalysisElevation "ElevationRegions"))
  (vlax-for Region ElevationRegions
    (setq Regionlist (list (vlax-get-property Region "Color")
                           (vlax-get-property Region "MinimumElevation")
                           (vlax-get-property Region "MaximumElevation")
		     )
	  AllRegions (cons Regionlist AllRegions)
    )   
      ;   Color = 26
    ;   MaximumElevation = 80.0
    ;   MinimumElevation = 60.0
  )
   (reverse allRegions)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun PUTTINDATA (DGMententity Regions
		   / DGMOBJECT ELEVATIONREGIONS SURFACEANALYSIS
		   SURFACEANALYSISELEVATION Regionobjlist)
  (setq DGMObject (vlax-ename->vla-object DGMententity))
  (setq SurfaceAnalysis (vlax-get-property DGMObject "SurfaceAnalysis"))
  (setq SurfaceAnalysisElevation (vlax-get-property SurfaceAnalysis "ElevationAnalysis"))

  (if (vl-catch-all-error-p
      (setq ElevationRegions
        (vl-catch-all-apply
          'vlax-invoke-method
	  (list SurfaceAnalysisElevation
	        "CalculateElevationRegions"
	        (length Regions)
	        :vlax-true
	  )
        )
      )	  
    )
    (Prompt "\nData nebylo možné přiřadit!")
    (progn

	(vlax-for Region ElevationRegions
    (setq regionobjlist (cons Region Regionobjlist))
  )
  (Setq tempmax (+ (last (last Regions))
		   (vlax-get-property (car regionobjlist) "MaximumElevation" )
		   (length Regions)
	        )
  )
  (foreach Region regionobjlist
    (vlax-put-property Region "MaximumElevation" tempmax)
    (vlax-put-property Region "MinimumElevation" (setq Tempmax (1- tempmax)))
  )
  (foreach Region (reverse regionobjlist)
    (vlax-put-property Region "Color" (caar Regions))
    (vlax-put-property Region "MinimumElevation" (cadar Regions))
    (vlax-put-property Region "MaximumElevation" (caddar Regions))
    (setq Regions (cdr Regions))
  )
  )
  )  
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Prompt (strcat "SurfaceElevation.lsp načten\n"
        	"K dispozici jsou příkazy TransferElevations, ImportElevations a\n"
		"ExportElevations."))
(prin1)