;;;KETIV - Insert delimited ascii text files into a drawing.
;;; DELIMIN.LSP
;;;
;;; KETIV Technologies, Inc.
;;; 6645 NE 78th Court #C-2
;;; Portland, OR 97218
;;;
;;; Layer Group: KTEXT
;;;
;;; Menu Location: Text I/O Pull down
;;;
;;; Purpose:Insert delimited ascii text files into a drawing
;;;
;;; Prompts:
;;;    Enter filename <Name.ext>:
;;;        [if the file is not found]
;;;        ERROR: File " fn " not found - try again
;;;        Enter filename <Name.ext>:
;;;    Enter column delimiter <,>:
;;;    Scanning file for # of rows/columns . . .
;;;        [if the text height is not set in the style]
;;;        Enter text height <default>:
;;;        [Else show current text style height]
;;;        Your current style is "style", which has a fixed text height of "height"
;;;    Enter line spacing <default>:
;;;    Enter text point:
;;;    Enter first column width <default>:
;;;    Enter text justification: Center/Right/<Left>:
;;;    Set column width automatically from 1st line? <Y>:
;;;    Enter text justification: Center/Right/<Left>:
;;;
;;; Assumptions/Limitations: None
;;;
;;;======================================================================================================
;;; Text importing utility for bringing Columnar data into AutoCAD.
;;; Requires an ASCII text file with column delimiter.
;;;
;;; FEATURES:  --Scans 1st line of file for # of columns
;;;            --Scans entire file for # of lines
;;;            --Adjusts for fixed or variable text height
;;;            --Read-out of current row/col # (in screen menu area)
;;;            --Read-out of percent done (in screen menu area)
;;;            --Scans 1st line for default width of columns
;;;            --Allows auto column width based on 1st line of text
;;;            --Auto column width makes each column left-justified
;;;            --Displays 1st text line when asking for delimiter
;;;            --If manual column width, can choose justification
;;;                 for each column (Left, Center, Right).
;;;
;;;----------------------------------------------------------------------------
;;; Initialize memory and important system variables
;;;--------------------------------------------------
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 1986, 1987, 1988, 1989 by KETIV Technologies, Inc.
;;;>		   EDITED: 10-22-2001
;;;
(defun c:delimin (/ acl aclt cd cdt clis clist cn cnum col col2 colno f f1 fn
                    first fixht hmc hmr hwf l1 l2 l1t lin ll lll ncd nm p1 rc
                    rnum rtd rtr rtr1 styht td tht tj tlis tlist tp ts
                 )
  (setq
        hdrlst '()
        clayer (getvar "clayer")
				mrk 0
  )
  ;------------------------
  ; Store system variables
  ;------------------------
  (mapcar '(lambda (var val)
             (setq hdrlst (cons (cons var (getvar var)) hdrlst))
             (setvar var val)
           )
          '("cmdecho" "blipmode" "limcheck" "highlight" "angbase" "osmode")
          (list 0 (getvar "blipmode") 0 0 0 0)
  )
;  (setlay "ktext")
  ;-------------------------------------
  ; "Wipe" and prepare screen menu area
  ;-------------------------------------
  (repeat 42 (grtext (setq mrk (1+ mrk)) "        "))
  (grtext 1 " KETIV")
  (grtext 1 " KETIV" 1)
  (grtext 3 "<< ** >>")
  (grtext 9 "________")
  (setq
    ;--------------------------------------------
    ; See if current text style has fixed height
    ;--------------------------------------------
    stylht (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))
    fixht  (if (= stylht 0.0) 0 1)
    ;-------------------------------------------------
    ; Open text file for input, set up initial values
    ;-------------------------------------------------
    fn     (getfiled "Import Delimited Text File" (getvar"dwgprefix") "txt" 4)
    f1     (open fn "r")
  )
  (while (not f1)
    (prompt (strcat "\nERROR: File " fn " not found - try again"))
    (setq fn  (getfiled "Import Delimited Text File" (getvar"dwgprefix") "txt" 4)
          f1 (open fn "r")
    )
  )
  (setq lin (read-line f1) cdt (substr lin 1 1))
  (prompt (strcat "1st LINE: " lin))
  (if f1
    (progn
      ;--------------------------------
      ; Get input for column delimiter
      ;--------------------------------
      (if (or (null cd) (= "" cd)) (setq cd ","))
      (setq cdt (getstring (strcat "\nEnter column delimiter <" cd ">: ")))
      (if (= "" cdt)
        (setq cdt cd)
        (setq cd cdt)
      )
      ;----------------------------------------------------
      ; Scan first line of text file for number of columns
      ;----------------------------------------------------
      (prompt "\nScanning file for # of rows/columns . . .")
      (setq
        hmr 0
        ncd 0
        nm  1
        ll  0
        lll '()
      )
      (while (not (= "" cdt))
        (setq cdt (substr lin nm 1) nm (1+ nm))
        (if (= cd cdt)
          (setq ncd (1+ ncd) lll (cons ll lll) ll 0)
          (setq ll (1+ ll))
        )
      )
      (setq lll (cons (- ll 1) lll)
            lll (reverse lll)
            hmc (1+ ncd)
            ncd nil
      )
      (while (not (null lin))
        (setq lin (read-line f1)
              hmr (1+ hmr)
        )
      )
      ;-----------------------------------------------------------------------
      ; Close file after 1st scan, report rows/cols, open file for text input
      ;-----------------------------------------------------------------------
      (if (null f1) (prompt "\nFILE NOT CLOSED!") (close f1))
      (grtext 6 (strcat "Rows:" (itoa hmr)))
      (grtext 7 (strcat "Cols:" (itoa hmc)))
      (setq f (open fn "r"))
      ;-------------------------------------------------
      ; Get text height or inform of current fixed size
      ;-------------------------------------------------
      (if (= fixht 0.0)
        (progn
          (initget 6)
          (prompt "\nEnter text height <") (prompt (rtos (getvar "textsize") 2 2))
          (setq tht (getdist ">: "))
          (if (null tht) (setq tht (getvar "textsize")))
        )
        (prompt (strcat "\nYour current style is " (getvar "textstyle")
                        ", which has a fixed text height of " (rtos stylht 2 3)))
      )
      ;----------------------------
      ; Get text angle (default 0)
      ;----------------------------
      (setq rtr (getangle "\nEnter text angle <0>: "))
      (if (null rtr) (setq rtr 0.0))
      ;---------------------------------------------
      ; Get line spacing (default is height * 1.66)
      ;---------------------------------------------
      (if (= fixht 0.0)
        (progn
          (initget 2)
          (prompt "\nEnter line spacing <") (prompt (rtos (* tht 1.66666) 2 2))
          (setq ts (getdist ">: "))
          (if (null ts) (setq ts (* tht 1.66666)))
        )
        (progn
          (initget 2)
          (prompt "\nEnter line spacing <") (prompt (rtos (* stylht 1.66666) 2 2))
          (setq ts (getdist ">: "))
          (if (null ts) (setq ts (* stylht 1.66666)))
        )
      )
      ;----------------------
      ; Get text start point
      ;----------------------
      (initget 1)
      (setq p1   (getpoint "\nEnter text point: ")
            rtd  (* (/ 180 pi) rtr)
            rtr1 (+ rtr (/ pi -2.0))
      )
      (initget 1)
      ;------------------------------------------------
      ; Start the column width list & text justif list
      ;------------------------------------------------
      (setq cnum hmc          ; HMC  = How many columns, CNUM = Col. #
            cn   0            ; CN   = Row number
            rnum 1            ; RNUM = Current row number
      )
      (if (= 1 fixht)
        (setq l1 (* stylht (nth 0 lll) 1.3))
        (setq l1 (* tht (nth 0 lll) 1.3))
      )
      (initget 2)
      (prompt "\nEnter first column width <") (prompt (rtos l1 2 2))
      (setq l1T (getdist ">: "))
      (if (null l1t) (setq l1t l1) (setq l1 l1t))
      (setq l2 (getstring "\nEnter text justification: Center/Right/<Left>: "))
      (if (null l2) (setq l2 "L"))
      (setq clis (list l1 0.0) tlis (list (strcase l2) 0.0))
      (setq colno 1 hwf (/ l1 (nth 0 lll)))
      ;-----------------------------------------------------
      ; Auto column spacing based on 1st line of text file?
      ;-----------------------------------------------------
      (initget "Y y N n")
      (if (or (null acl) (= "" acl)) (setq acl "Y"))
      (prompt "\nSet column width automatically from 1st line? <")
      (prompt acl)
      (setq aclt (getstring ">: "))
      (if (= "" aclt) (setq acl acl) (setq acl aclt))
      ;-------------------------------------------------
      ; Build the column width list & text justif. list
      ;-------------------------------------------------
      (repeat (- cnum 1)
        (setq colno (+ 1 colno))
        (if (or (= acl "y") (= acl "Y"))
          (setq clist (* hwf (nth (- colno 1) lll)) tlist "")
          (progn
            (setq clist
              (getdist
                (strcat "\nEnter column " (itoa colno) " width <"
                        (rtos (* hwf (nth (- colno 1) lll)) 2 2) ">: "
                )
              )
            )
            (prompt (rtos (* hwf (nth (- colno 1) lll)) 2 2))
            (if (null clist) (setq clist (* hwf (nth (- colno 1) lll))))
            (setq tlist
              (getstring "\nEnter text justification: Center/Right/<Left>: ")
            )
          )
        )
        (setq
          clis (cons clist clis)
          tlis (cons (strcase tlist) tlis)
        )
      ) ;end repeat
      ;------------------------------------------
      ; Reverse the order of the lists just made
      ;------------------------------------------
      (setq clis (reverse clis)
            tlis (reverse tlis)
      )
      ;-------------------------------------------------------------------
      ; 1 Begin "WHILE" for char-by-char input from file, until all chars
      ;-------------------------------------------------------------------
      (setq col 0                    ; COL is column/character number
            rc  0
      )
      (while (< (- rnum 1) hmr)
        (setq tp   p1                  ; TP is text point (upper left)
              cn   (1+ cn)             ; CN is overall column number
              cnum 0                   ; CNUM is current column number
        )
        (grtext 6 (strcat "RoL: " (itoa rnum)))
        (grtext 7 (strcat "Col: " (itoa (+ cnum 1))))
        (grtext 8 (strcat " [" (rtos (/ (+ cnum (* (- rnum 1) hmc)) (* hmr hmc 0.01)) 2 0) "%]"))
        (setq col   cd
              col   (read-char f)
              first (if (= col (ascii cd)) t nil)
        )
        ;-----------------------------------------------------------
        ; 2 Begin accepting input from file, until "line-feed" char
        ;-----------------------------------------------------------
        (while (and col (/= col 10))
           (setq
             col (if (and (> col 31) (< col 128))
                   col
                   (read-char f)
                 )
             cn  (1+ cn)             ; CN is overall column number
           )
           (grtext 6 (strcat "RoL: " (itoa rnum)))
           (grtext 7 (strcat "Col: " (itoa (+ cnum 1))))
           (grtext 8 (strcat " [" (rtos (/ (+ cnum (* (- rnum 1) hmc)) (* hmr hmc 0.01)) 2 0) "%]"))
           (if (not first) (setq col (if (= col (ascii cd)) (read-char f) col)))
           ;--------------------------------------------------------
           ; 3 Build individual text string "COL2" for Text command
           ;--------------------------------------------------------
           (setq col2 "")
           (while (and col (not first) (/= col 10) (/= col (ascii cd)))
             (setq col2 (strcat col2 (chr col))
                   col  (read-char f)
             )
           )  ; End 3rd "WHILE"
           (setq col2 (if (= col2 "") (chr col) col2)
                 tj   (nth (+ cnum 1) tlis)
                 td   (nth (+ cnum 1) clis)
                 tp   (polar tp 0.0 (if (= tj "C") (/ td 2) (if (= tj "R") td 0.0)))
           )
           ;--------------------------------
           ; Enter text string into drawing
           ;--------------------------------
           (setvar "blipmode" 0)
           (if (and (not first) (/= col2 (chr 10)) (/= col2 cd))
             (if (= fixht 0)
               (if (or (= tj "C") (= tj "R"))
                 (command ".text" tj tp tht rtd col2)
                 (command ".text" tp tht rtd col2)
               )
               (if (or (= tj "C") (= tj "R"))
                 (command ".text" tj tp rtd col2)
                 (command ".text" tp rtd col2)
               )  ;End "IF" for text justif. & text entry to ACAD
             )
           )
           (setq first nil)
           (setq tp (polar tp 0.0 (if (= tj "C") (/ td 2)
             (if (= tj "R") 0.0 td)))
           )
           (setq cnum (+ cnum 1))
        )  ; End 2nd "WHILE"
        (setq p1 (polar p1 rtr1 ts))
        (if (and col (/= 10 col)) (setq rc (read-char f)))
        (setq col (if (= rc nil) nil rc))
        (setq rnum (+ rnum 1))
      )  ;End 1st "WHILE"
      (close f)
      (grtext)
    )     ;End progn if file can be opened
  )       ;End if for "f" file
  ;======================================================================================================
  ; Reset system variables and AutoLISP memory
  (command ".layer" "s" clayer "")
  (foreach cnt hdrlst (setvar (car cnt) (cdr cnt)))
  (setvar "highlight" 1)
  (princ)
)
(princ)