Le portail francophone de la géomatique

(defun c:OD2CSV ( / js filename cle f_open key_sep n obj tbllist tbldef tblstr fldnamelist fldtypelist fldnme fldtyp numrec ct cttemp vallist typ val)
  (setq js
    (ssget "_X"
      (list
        '(0 . "*")
        (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
        (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
      )
    )
  )
  (cond
    (js
      (setq file_name (getfiled "Nom du fichier a créer ?: " (strcat (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 3)) "csv") "csv" 37))
      (if (null file_name) (exit))
      (if (findfile file_name)
        (progn
          (prompt "\nFichier existe déjà!")
          (initget "Ajoute Remplace annUler _Add Replace Undo")
          (setq cle
            (getkword "\nDonnées dans fichier? [Ajouter/Remplacer/annUler] <R>: ")
          )
          (cond
            ((eq cle "Add")
              (setq cle "a")
            )
            ((or (eq cle "Replace") (eq cle ()))
              (setq cle "w")
            )
            (T (exit))
          )
          (setq f_open (open file_name cle))
        )
        (setq f_open (open file_name "w"))
      )
      (initget "Espace Virgule Point-virgule Tabulation _SPace Comma SEmicolon Tabulation")
      (setq key_sep (getkword "\nSéparateur [Espace/Virgule/Point-virgule/Tabulation]? <Point-virgule>: "))
      (cond
        ((eq key_sep "SPpace") (setq str_sep " "))
        ((eq key_sep "Comma") (setq str_sep ","))
        ((eq key_sep "Tabulation") (setq str_sep "\t"))
        (T (setq str_sep ";"))
      )
      (repeat (setq n (sslength js))
        (setq obj (ssname js (setq n (1- n))))
        (if (not (null (setq tbllist (ade_odgettables obj))))
          (foreach tbl tbllist
            (setq
              tbldef (ade_odtabledefn tbl)
              tblstr (cdr (nth 2 tbldef))
              fldnamelist ()
              fldtypelist ()
            )
            (foreach fld tblstr
              (setq
                fldnme (cdr (nth 0 fld))
                fldtyp (cdr (nth 2 fld))
                fldnamelist (append fldnamelist (list fldnme))
                fldtypelist (append fldtypelist (list fldtyp))
              )
            )
            (setq numrec (ade_odrecordqty obj tbl) ct 0)
            (while (< ct numrec)
              (setq cttemp 0 vallist ())
              (foreach fld fldnamelist
                (setq
                  typ (nth cttemp fldtypelist)
                  cttemp (+ cttemp 1)
                  val (ade_odgetfield obj tbl fld ct)
                )
                (if (= typ "Integer")(setq val (fix val)))
                (setq vallist (append vallist (list val)))
              )
              (setq ct (+ ct 1))
            )
            (foreach n fldnamelist
              (write-line
                (strcat
                  n str_sep
                  (car fldtypelist) str_sep
                  (cond
                    ((eq (car fldtypelist) "Character") (car vallist))
                    ((eq (car fldtypelist) "Integer") (itoa (car vallist)))
                    ((eq (car fldtypelist) "Real") (rtos (car vallist)))
                    ((eq (car fldtypelist) "Point")
                      (rtos (car (car vallist))) str_sep
                      (rtos (cadr (car vallist))) str_sep
                      (rtos (caddr (car vallist)))
                    )
                  )
                )
                f_open
              )
              (setq fldtypelist (cdr fldtypelist) vallist (cdr vallist))
            )
            (write-line "" f_open)
          )
        )
      )
      (close f_open)
    )
  )
  (prin1)
)