Capítulo 8.lsp

		;;;Código fuente del libro "Experto AutoCAD con Visual LISP"
		;;; (c) 2012 Ediciones ARTUAL, S.L. Barcelona, España.
		;;; (c) 2012-2020 Reinaldo Togores. Todos los derechos reservados
		;;; Se permite su uso mencionando la obra y su autor.
;;;Capítulo 8.  Operaciones con archivos.

(defun lee-letras (archivo / id-archivo textos) 
  (if (setq id-archivo (open (findfile archivo) "r")) 
    (progn (setq textos "") 
           (while (setq letra (read-char id-archivo)) 
             (setq textos (strcat textos (chr letra))))
           (close id-archivo)
           (alert textos))))
		;;;Listado 8.1. Lectura de un archivo letra a letra.

(defun archivo->lista (archivo / id-archivo tmp) 
  (if (setq id-archivo (open (findfile archivo) "r")) 
    (while (setq linea (read-line id-archivo)) 
      (setq tmp (cons (read (strcat "(" linea ")")) tmp)))
    (close id-archivo))
  (reverse tmp))
		;;;Listado 8.2. Lectura de un archivo a una lista.

(defun lista->csv (lista delim archivo anexar / id-archivo) 
  (if 
    (setq id-archivo (open archivo 
                           (if anexar 
                             "a"
                             "w")))
    (progn 
      (foreach sublista lista 
        (while (setq valor (car sublista)) 
          (prin1 valor id-archivo)
          (if (setq sublista (cdr sublista)) 
            (princ delim id-archivo)))
        (write-char 10 id-archivo))
      (close id-archivo))))
;;;Listado 8.3. Función lista->csv.

(defun lista->textos (lista prec) 
  (mapcar 
    '(lambda (x) 
       (mapcar 
         '(lambda (y) 
            (if (numberp y) 
              (rtos y 2 prec)
              (vl-princ-to-string y)))
         x))
    lista))
		;;;Listado 8.4. Conversión de elementos de listas a textos.

(defun long-cadena (caracter cadena long / veces) 
  (setq veces (- long (strlen cadena)))
  (cond 
    ((zerop veces) cadena)
    ((minusp veces) (substr cadena 1 long))
    (t
     (repeat veces (setq cadena (strcat cadena caracter))))))
		;;;Listado 8.5. Llevar una cadena a una longitud fija.

(defun lista->sdf (lista long prec caracter archivo anexar / id-archivo tmp) 
  (if 
    (setq id-archivo (open archivo 
                           (if anexar 
                             "a"
                             "w")))
    (progn (setq lista (lista->textos lista prec)) 
           (foreach sublista lista 
             (setq tmp "")
             (foreach valor sublista 
               (setq tmp (strcat tmp (long-cadena caracter valor long))))
             (write-line tmp id-archivo))
           (close id-archivo))))
;;;Listado 8.6. Función LISTA->SDF.

(defun existe-archivo? (nombre carpeta) 
  (vl-directory-files carpeta nombre 1))
		;;;Listado 8.7. Función para búsqueda de un archivo.

(defun unidades (/ codigo tmp) 
  (setq codigo 65)
  (while (<= codigo 90) 
    (if (vl-directory-files (strcat (chr codigo) ":")) 
      (setq tmp (cons (strcat (chr codigo) ":") tmp)))
    (setq codigo (1+ codigo)))
  (reverse tmp))
		;;;Listado 8.8. Función para reconocer unidades de disco disponibles.

(defun crea-lista-puntos (/ pt tmp) 
  (while (setq pt (getpoint "\nDesigne Punto: ")) 
    (setq tmp (cons pt tmp)))
  tmp)
		;;;Listado 8.9. Función CREA-LISTA-PUNTOS para crear una lista de coordenadas.