;;; ---------------------------------------------------------------------------
;;; PointImport.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; COORDINATE FILE IMPORT
;;;
;;; PURPOSE
;;;   Reads a text file of coordinates and builds geometry from it - survey
;;;   points from a total station, setting-out data, a traverse, a profile, or
;;;   anything else that arrives as columns of numbers.
;;;
;;;   It will make POINT objects, a chain of lines, a polyline, a 3D polyline,
;;;   a block at each coordinate, or a copy of anything you select.
;;;
;;; THE TWO COLUMN ORDERS
;;;   XYZ     X, Y and optionally Z, in the natural order.
;;;
;;;   PNEZD   Point number, Northing, Easting, Elevation, Description - the
;;;           standard survey exchange order, and the one that catches people
;;;           out, because NORTHING COMES FIRST AND IT IS THE Y AXIS. A file
;;;           read as XYZ when it is really PNEZD comes in transposed and
;;;           usually a long way from the origin. If your points land in the
;;;           wrong place with north and east swapped, this is why.
;;;
;;;   With PNEZD the point number and description can be placed as text beside
;;;   each point, which is what makes a survey drawing readable.
;;;
;;; SEPARATORS
;;;   Commas, tabs, semicolons or runs of spaces. It works out which by looking
;;;   at the first line with data on it, so mixed files are fine as long as they
;;;   are consistent. Blank lines and lines starting with ; or # are skipped.
;;;
;;; WHAT WAS FIXED
;;;   - A blank line anywhere in the file crashed it. Its trimming loop ran
;;;     (substr s (strlen s)) which becomes (substr s 0) on an empty string, and
;;;     SUBSTR will not accept a start position of zero. Trailing blank lines are
;;;     extremely common, so this was not an edge case.
;;;   - There was no error handler of any kind. An unreadable line left the file
;;;     open, BLIPMODE and HIGHLIGHT changed, and the UNDO group unclosed - so
;;;     the next U undid an unpredictable amount of work.
;;;   - CMDECHO was set to 0 and never put back.
;;;   - Comma-delimited lines were parsed by running (command "setvar" "lastpoint"
;;;     <the line>) and reading LASTPOINT back - a real command invocation per
;;;     line, just to convert text to a point. Parsing the string directly is
;;;     both faster and does not depend on the state of the command processor.
;;;   - Space-delimited lines were parsed with (read (strcat "(" line ")")),
;;;     which turns anything non-numeric into a symbol and quietly produces
;;;     nonsense instead of reporting a bad line.
;;;   - The helper functions were named cdf, sdf, noz and strtrim, all global.
;;;   - Every point was fed to one command call through APPLY, which puts the
;;;     whole file into a single command line. Geometry is now built with
;;;     ENTMAKE, which has no such limit and is far quicker on a large file.
;;;   - The file ended with a stray </PRE> tag, left over from being saved off a
;;;     web page.
;;;
;;;   PTIMPORT  - read a coordinate file and build geometry
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; TEXT HANDLING
;;; ---------------------------------------------------------------------------

;;; Trim spaces, tabs and stray carriage returns from both ends. Returns nil for
;;; a line with nothing on it, which is how blank lines get skipped.
(defun PtImp:Trim ( s / junk )
    (setq junk '(" " "\t" "\r" "\n"))
    (while (and (> (strlen s) 0) (member (substr s 1 1) junk))
        (setq s (substr s 2)))
    (while (and (> (strlen s) 0) (member (substr s (strlen s) 1) junk))
        (setq s (substr s 1 (1- (strlen s)))))
    (if (= s "") nil s)
)

;;; Split on a single character. Runs of the separator collapse into one, which
;;; is what makes space-delimited columns work however they are lined up.
(defun PtImp:Split ( s sep / i ch cur out )
    (setq i 0 cur "" out nil)
    (while (< i (strlen s))
        (setq i (1+ i) ch (substr s i 1))
        (if (or (= ch sep) (and (= sep " ") (= ch "\t")))
            (if (/= cur "") (setq out (cons cur out) cur ""))
            (setq cur (strcat cur ch))))
    (if (/= cur "") (setq out (cons cur out)))
    (reverse out)
)

;;; Which separator this file uses, judged from a sample line.
(defun PtImp:Sniff ( line )
    (cond ((vl-string-search "," line) ",")
          ((vl-string-search "\t" line) "\t")
          ((vl-string-search ";" line) ";")
          (t " "))
)

;;; True if a string is a number and nothing else. ATOF returns 0.0 for rubbish,
;;; so a plain (atof s) cannot tell 0 from a bad field - this can.
(defun PtImp:IsNum ( s / i ch seen dot )
    (setq i 0 seen nil dot nil)
    (if (member (substr s 1 1) '("-" "+")) (setq s (substr s 2)))
    (if (= s "")
        nil
        (progn
            ;; NOT EQ rather than /= - the marker here is a symbol, and /= is
            ;; only defined for numbers and strings.
            (while (and (< i (strlen s)) (not (eq 'bad seen)))
                (setq i (1+ i) ch (substr s i 1))
                (cond ((wcmatch ch "#") (setq seen t))
                      ((and (= ch ".") (not dot)) (setq dot t))
                      (t (setq seen 'bad))))
            (eq seen t))
    )
)

;;; ---------------------------------------------------------------------------
;;; ENTITY MAKING
;;; ---------------------------------------------------------------------------

(defun PtImp:Layer ( name colour )
    (if (and name (not (tblsearch "LAYER" name)))
        (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord")
                       '(100 . "AcDbLayerTableRecord") (cons 2 name)
                       '(70 . 0) (cons 62 colour) '(6 . "Continuous"))))
    name
)

(defun PtImp:Point ( p layer )
    (entmake (list '(0 . "POINT") (cons 8 layer) (cons 10 p)))
)

(defun PtImp:Line ( p1 p2 layer )
    (entmake (list '(0 . "LINE") (cons 8 layer) (cons 10 p1) (cons 11 p2)))
)

(defun PtImp:Text ( p hgt txt layer )
    (if (and txt (/= "" txt))
        (entmake (list '(0 . "TEXT") (cons 8 layer) (cons 10 p)
                       (cons 40 hgt) (cons 1 txt))))
)

(defun PtImp:LwPoly ( pts layer )
    (entmake (append
        (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 layer)
              '(100 . "AcDbPolyline") (cons 90 (length pts)) '(70 . 0))
        (mapcar '(lambda ( p ) (cons 10 (list (car p) (cadr p)))) pts)))
)

;;; A 3D polyline is an old-style POLYLINE header, one VERTEX per point, and a
;;; SEQEND to close the sequence. Flag 8 on the header and 32 on each vertex are
;;; what make it three dimensional rather than a flat polyline.
(defun PtImp:Poly3d ( pts layer )
    (entmake (list '(0 . "POLYLINE") (cons 8 layer) '(66 . 1) '(70 . 8)
                   '(10 0.0 0.0 0.0)))
    (foreach p pts
        (entmake (list '(0 . "VERTEX") (cons 8 layer) (cons 10 p) '(70 . 32))))
    (entmake (list '(0 . "SEQEND") (cons 8 layer)))
)

;;; ---------------------------------------------------------------------------
;;; MAIN COMMAND
;;; ---------------------------------------------------------------------------

(defun c:PTIMPORT ( / *error* vars vals file fh line sep fields order what
                      pts labels n bad first lay laytxt hgt blk ss
                      xmin xmax ymin ymax zmin zmax p num desc prev v )

    (setq vars '("CMDECHO" "BLIPMODE" "HIGHLIGHT" "CLAYER" "OSMODE" "ATTREQ")
          vals (mapcar 'getvar vars))

    (defun PtImp:Restore ( )
        (if fh (vl-catch-all-apply 'close (list fh)))
        (setq fh nil)
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End"))
        (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        (princ)
    )

    (defun *error* ( msg )
        (PtImp:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** PTIMPORT error: " msg " **")))
        (princ)
    )

    (setvar "CMDECHO" 0)
    (setvar "BLIPMODE" 0)
    (setvar "OSMODE" 0)
    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler unless
    ;; the routine says up front that it will use one.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (setq file (getfiled "Coordinate file to read" "" "txt;csv;asc;pnt;dat;*" 4))

    (if (null file)
        (princ "\nCancelled.")
        (if (null (setq fh (open file "r")))
            (princ (strcat "\n** Cannot open " file " **"))
            (progn
                ;; --- work out the separator from the first line with data ----
                (setq first nil)
                (while (and (null first) (setq line (read-line fh)))
                    (setq line (PtImp:Trim line))
                    (if (and line (not (member (substr line 1 1) '(";" "#"))))
                        (setq first line)))
                (close fh)
                (setq fh nil)

                (if (null first)
                    (princ "\n** There is no data in that file. **")
                    (progn
                        (setq sep    (PtImp:Sniff first)
                              fields (length (PtImp:Split first sep)))

                        (princ (strcat "\nSeparator: "
                                       (cond ((= sep ",") "comma")
                                             ((= sep "\t") "tab")
                                             ((= sep ";") "semicolon")
                                             (t "spaces"))
                                       "   Columns: " (itoa fields)))
                        (princ (strcat "\nFirst line: " first))

                        ;; --- column order -------------------------------------
                        (initget "Xyz Pnezd")
                        (setq v (getkword
                            (strcat "\nColumn order [Xyz/Pnezd] <"
                                    (if (>= fields 4) "Pnezd" "Xyz") ">: ")))
                        (setq order (cond (v v)
                                          ((>= fields 4) "Pnezd")
                                          (t "Xyz")))

                        ;; --- what to build ------------------------------------
                        (initget "Points Lines Pline 3Dpoly Blocks Copies")
                        (setq what (getkword
                            "\nBuild [Points/Lines/Pline/3Dpoly/Blocks/Copies] <Points>: "))
                        (if (null what) (setq what "Points"))

                        (if (= what "Blocks")
                            (progn
                                (setq blk (getstring t "\nBlock name to insert: "))
                                (if (not (tblsearch "BLOCK" blk))
                                    (progn
                                        (princ (strcat "\n** No block called \""
                                                       blk "\" in this drawing. **"))
                                        (setq what nil)))))

                        (if (= what "Copies")
                            (progn
                                (princ "\nSelect the objects to copy to each coordinate.")
                                (setq ss (ssget))
                                (if (null ss)
                                    (progn (princ "\n** Nothing selected. **")
                                           (setq what nil)))))

                        ;; --- annotation ---------------------------------------
                        (setq labels nil)
                        (if (and what (= order "Pnezd"))
                            (progn
                                (initget "Yes No")
                                (if (= "Yes" (getkword
                                        "\nLabel with point number and description [Yes/No] <No>: "))
                                    (progn
                                        (initget 6)
                                        (setq hgt (getdist "\n  Text height: ")
                                              labels t)))))

                        ;; --- read the file ------------------------------------
                        (if what
                            (progn
                                (setq lay    (PtImp:Layer "Survey-Points" 7)
                                      laytxt (PtImp:Layer "Survey-Text" 3)
                                      fh (open file "r")
                                      pts nil n 0 bad 0)

                                (while (setq line (read-line fh))
                                    (setq line (PtImp:Trim line))
                                    (if (and line
                                             (not (member (substr line 1 1) '(";" "#"))))
                                        (progn
                                            (setq fields (PtImp:Split line sep)
                                                  p nil num nil desc nil)
                                            (cond
                                                ;; X, Y and maybe Z.
                                                ((= order "Xyz")
                                                 (if (and (>= (length fields) 2)
                                                          (PtImp:IsNum (car fields))
                                                          (PtImp:IsNum (cadr fields)))
                                                     (setq p (list (atof (car fields))
                                                                   (atof (cadr fields))
                                                                   (if (and (> (length fields) 2)
                                                                            (PtImp:IsNum (caddr fields)))
                                                                       (atof (caddr fields))
                                                                       0.0)))))

                                                ;; Point number, Northing, Easting,
                                                ;; Elevation, Description. Northing
                                                ;; is Y and Easting is X, so the
                                                ;; middle two swap on the way in.
                                                (t
                                                 (if (and (>= (length fields) 3)
                                                          (PtImp:IsNum (cadr fields))
                                                          (PtImp:IsNum (caddr fields)))
                                                     (setq num  (car fields)
                                                           p    (list (atof (caddr fields))
                                                                      (atof (cadr fields))
                                                                      (if (and (> (length fields) 3)
                                                                               (PtImp:IsNum (nth 3 fields)))
                                                                          (atof (nth 3 fields))
                                                                          0.0))
                                                           desc (if (> (length fields) 4)
                                                                    (nth 4 fields))))))

                                            (if (null p)
                                                (setq bad (1+ bad))
                                                (progn
                                                    (setq pts (cons p pts) n (1+ n))
                                                    ;; Running extents, so the summary
                                                    ;; can say where the data landed.
                                                    (if (null xmin)
                                                        (setq xmin (car p) xmax (car p)
                                                              ymin (cadr p) ymax (cadr p)
                                                              zmin (caddr p) zmax (caddr p))
                                                        (setq xmin (min xmin (car p))
                                                              xmax (max xmax (car p))
                                                              ymin (min ymin (cadr p))
                                                              ymax (max ymax (cadr p))
                                                              zmin (min zmin (caddr p))
                                                              zmax (max zmax (caddr p))))

                                                    (if labels
                                                        (progn
                                                            (PtImp:Text
                                                                (list (+ (car p) (* hgt 0.6))
                                                                      (+ (cadr p) (* hgt 0.4))
                                                                      (caddr p))
                                                                hgt num laytxt)
                                                            (PtImp:Text
                                                                (list (+ (car p) (* hgt 0.6))
                                                                      (- (cadr p) (* hgt 1.4))
                                                                      (caddr p))
                                                                hgt desc laytxt))))))))

                                (close fh)
                                (setq fh nil pts (reverse pts))

                                ;; --- build it ----------------------------------
                                (cond
                                    ((zerop n)
                                     (princ "\n** No usable coordinates found. **"))

                                    ((= what "Points")
                                     (foreach p pts (PtImp:Point p lay)))

                                    ((= what "Lines")
                                     (setq prev nil)
                                     (foreach p pts
                                         (if prev (PtImp:Line prev p lay))
                                         (setq prev p)))

                                    ((= what "Pline")
                                     (if (> n 1)
                                         (PtImp:LwPoly pts lay)
                                         (princ "\n** A polyline needs at least two points. **")))

                                    ((= what "3Dpoly")
                                     (if (> n 1)
                                         (PtImp:Poly3d pts lay)
                                         (princ "\n** A 3D polyline needs at least two points. **")))

                                    ((= what "Blocks")
                                     (setvar "ATTREQ" 0)
                                     (foreach p pts
                                         (entmake (list '(0 . "INSERT") (cons 8 lay)
                                                        (cons 2 blk) (cons 10 p)
                                                        '(41 . 1.0) '(42 . 1.0)
                                                        '(43 . 1.0) '(50 . 0.0)))))

                                    ((= what "Copies")
                                     (setvar "HIGHLIGHT" 0)
                                     (foreach p pts
                                         (command "_.COPY" ss "" "0,0,0" p))))

                                ;; --- what happened -----------------------------
                                (princ (strcat "\n\n" (itoa n) " coordinate"
                                               (if (= n 1) "" "s") " read"
                                               (if (> bad 0)
                                                   (strcat ", " (itoa bad)
                                                           " line" (if (= bad 1) "" "s")
                                                           " skipped as unreadable")
                                                   "")
                                               "."))
                                (if (> n 0)
                                    (princ (strcat
                                        "\n  East  " (rtos xmin 2 3) " to " (rtos xmax 2 3)
                                        "\n  North " (rtos ymin 2 3) " to " (rtos ymax 2 3)
                                        "\n  Level " (rtos zmin 2 3) " to " (rtos zmax 2 3)
                                        "\n\nZOOM Extents to find them.")))
                            )
                        )
                    )
                )
            )
        )
    )

    (PtImp:Restore)
    (princ)
)

(princ)