Chapter 8 Source Code.

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