;;;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.
