;;; Source code from the book "AutoCAD expert's Visual LISP"
;;; (c) 2012 Ediciones ARTUAL, S.L. Barcelona, España.
;;; Copyright © 2012-2018 by Reinaldo N. Togores. All rights reserved.
;;; Use of this code is allowed mentioning the book and its author.
;;;Chapter 8. File Operations
(defun read-letters (file / file-id txt-str)
(if (setq file-id (open (findfile file) "r"))
(progn (setq txt-str "")
(while (setq character (read-char file-id))
(setq txt-str (strcat txt-str (chr character))))
(close file-id)
(alert txt-str))))
;;;Listing 8.1. Reading a file character by character.
(defun file->list (file / file-id tmp)
(if (setq file-id (open file "r"))
(while (setq txt-line (read-line file-id))
(setq tmp (cons (read (strcat "(" txt-line ")")) tmp)))
(close file-id))
(reverse tmp))
;;;Listing 8.2. Reading a file into a list.
(defun list->csv (lst delim file add / file-id)
(if
(setq file-id (open file
(if add
"a"
"w")))
(progn
(foreach sublist lst
(while (setq value (car sublist))
(prin1 value file-id)
(if (setq sublist (cdr sublist))
(princ delim file-id)))
(write-char 10 file-id))
(close file-id))))
;;;Listing 8.3. LIST->CSV Function.
(defun list->text (lst prec)
(mapcar
'(lambda (x)
(mapcar
'(lambda (y)
(if (numberp y)
(rtos y 2 prec)
(vl-princ-to-string y)))
x))
lst))
;;;Listing 8.4. Conversion of list items to text.
(defun length-string (character string long / times)
(setq times (- long (strlen string)))
(cond
((zerop times) string)
((minusp times) (substr string 1 long))
(t
(repeat times (setq string (strcat string character))))))
;;;Listing 8.5. Giving a string a fixed length.
(defun list->sdf (lst long prec character file add / file-id tmp)
(if
(setq file-id (open file
(if add
"a"
"w")))
(progn (setq lst (list->text lst prec))
(foreach sublist lst
(setq tmp "")
(foreach value sublist
(setq tmp (strcat tmp (length-string character value long))))
(write-line tmp file-id))
(close file-id))))
;;;Listing 8.6. LIST->SDF function.
(defun file-exists? (name folder)
(vl-directory-files folder name 1))
;;;Listing 8.7. File searching function.
(defun drives (/ code tmp)
(setq code 65)
(while (<= code 90)
(if (vl-directory-files (strcat (chr code) ":"))
(setq tmp (cons (strcat (chr code) ":") tmp)))
(setq code (1+ code)))
(reverse tmp))
;;;Listing 8.8. Function to recognize available disk drives.
(defun make-point-list (/ pt tmp)
(while (setq pt (getpoint "\nSpecify point: "))
(setq tmp (cons pt tmp)))
tmp)
;;;Listing 8.9. MAKE-POINT-LIST function for creating a coordinates list.
No comments:
Post a Comment