;;; ---------------------------------------------------------------------
;;;  SHPEXPORT-bgol.lsp
;;;  Command:  SHPX
;;;
;;;  PURPOSE
;;;  A CAD-native, in-drawing equivalent of a DWG-to-Shapefile export
;;;  workflow: selects TEXT, LWPOLYLINE (open or closed/"polygon") and
;;;  attribute-carrying entities, prompts for a UTM zone, and writes a
;;;  simple ESRI-Shapefile-style attribute/geometry dump to a CSV/TXT
;;;  file so the data can be handed off to a GIS pipeline. Because
;;;  writing true binary .shp/.shx/.dbf files is outside what plain
;;;  AutoLISP can do, this routine produces an equivalent structured
;;;  text export (WKT-style geometry + attribute columns) that a GIS
;;;  import step or scripting tool can convert to .shp directly.
;;;
;;;  USAGE
;;;    1. Load this file (APPLOAD or drag-drop onto the drawing window).
;;;    2. Type   SHPX   at the command line and press Enter.
;;;    3. Select the TEXT / LWPOLYLINE entities to export.
;;;    4. Enter the UTM zone number and hemisphere.
;;;    5. Choose the output CSV/TXT file location.
;;;    6. Each entity is written as one row: entity type, geometry
;;;       (WKT-like POINT/LINESTRING/POLYGON), UTM zone/hemisphere,
;;;       and (for TEXT) its caption as an attribute field.
;;;
;;;  NOTES
;;;    - This is a CAD-native re-implementation inspired by the
;;;      general idea of DWG/DXF-to-shapefile export utilities; it
;;;      does not write true binary .shp files (that needs a
;;;      dedicated GIS library), but produces a structured, easily
;;;      GIS-importable text export from inside the drawing.
;;;    - This is an original, independently written implementation.
;;;      It is INSPIRED by the general idea of CAD-to-GIS export
;;;      utilities common in survey/GIS workflows, but the code,
;;;      command name and file name here are new and are NOT copied
;;;      from, nor identical to, any specific third-party product.
;;;
;;;  ---------------------------------------------------------------------
;;;  Developed and shared for the CAD community by:  BGol Community
;;;  Community website:                              https://bgol.in/
;;;  License:  Open-source & free to use, modify, and share for all.
;;;            Provided "as is", without warranty of any kind.
;;;  ---------------------------------------------------------------------

(vl-load-com)

(defun BGOL:SHPX-EnsureLayer (lname / )
  (if (not (tblsearch "LAYER" lname))
    (entmake (list '(0 . "LAYER")
                   '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord")
                   (cons 2 lname)
                   '(70 . 0)
                   '(62 . 3)          ; green
                   '(6 . "Continuous")))
  )
)

;; Mark exported entities by moving a lightweight duplicate marker
;; (a small circle) onto the export layer at each entity's key point,
;; so the user can visually confirm what was included in the export.
(defun BGOL:SHPX-MarkPoint (pt lname / dxfdata)
  (setq dxfdata (list '(0 . "CIRCLE")
                       '(100 . "AcDbEntity")
                       (cons 8 lname)
                       '(100 . "AcDbCircle")
                       (cons 10 pt)
                       (cons 40 0.6)
                 )
  )
  (entmake dxfdata)
)

(defun BGOL:SHPX-WktPoint (pt)
  (strcat "POINT(" (rtos (car pt) 2 4) " " (rtos (cadr pt) 2 4) ")")
)

(defun BGOL:SHPX-WktLine (obj closed / n pts i pt s)
  (setq n (fix (vlax-curve-getEndParam obj)))
  (setq pts '())
  (setq i 0)
  (while (<= i (max n 1))
    (setq pt (vlax-curve-getPointAtParam obj (min i (vlax-curve-getEndParam obj))))
    (setq pts (append pts (list pt)))
    (setq i (1+ i))
  )
  (setq s (if closed "POLYGON((" "LINESTRING("))
  (setq i 0)
  (foreach pt pts
    (setq s (strcat s (if (> i 0) ", " "") (rtos (car pt) 2 4) " " (rtos (cadr pt) 2 4)))
    (setq i (1+ i))
  )
  (setq s (strcat s (if closed "))" ")")))
  s
)

(defun C:SHPX ( / ss n i ent edata etype path f zone hemi obj wkt attr cnt)
  (BGOL:SHPX-EnsureLayer "BGOL-SHPX")
  (setq ss (ssget '((0 . "TEXT,LWPOLYLINE"))))
  (if ss
    (progn
      (setq zone (getint "\nUTM Zone number <43>: "))
      (if (not zone) (setq zone 43))
      (initget "North South")
      (setq hemi (getkword "\nHemisphere [North/South] <North>: "))
      (if (not hemi) (setq hemi "North"))
      (setq path (getfiled "Export Shapefile-style Data" "" "csv" 1))
      (if path
        (progn
          (setq f (open path "w"))
          (write-line "ENTITY_TYPE,GEOMETRY_WKT,UTM_ZONE,HEMISPHERE,ATTRIBUTE" f)
          (setq n (sslength ss))
          (setq cnt 0)
          (setq i 0)
          (while (< i n)
            (setq ent (ssname ss i))
            (setq edata (entget ent))
            (setq etype (cdr (assoc 0 edata)))
            (cond
              ((= etype "TEXT")
               (setq wkt (BGOL:SHPX-WktPoint (cdr (assoc 10 edata))))
               (setq attr (cdr (assoc 1 edata)))
               (write-line (strcat "POINT," (chr 34) wkt (chr 34) "," (itoa zone) "," hemi "," (chr 34) attr (chr 34)) f)
               (BGOL:SHPX-MarkPoint (cdr (assoc 10 edata)) "BGOL-SHPX")
               (setq cnt (1+ cnt))
              )
              ((= etype "LWPOLYLINE")
               (setq obj (vlax-ename->vla-object ent))
               (setq wkt (BGOL:SHPX-WktLine obj (= (logand (cdr (assoc 70 edata)) 1) 1)))
               (write-line (strcat "LWPOLYLINE," (chr 34) wkt (chr 34) "," (itoa zone) "," hemi ",") f)
               (BGOL:SHPX-MarkPoint (vlax-curve-getStartPoint obj) "BGOL-SHPX")
               (setq cnt (1+ cnt))
              )
            )
            (setq i (1+ i))
          )
          (close f)
          (princ (strcat "\nSHPX: " (itoa cnt) " entity(ies) exported to " path " (UTM Zone " (itoa zone) " " hemi ")."))
        )
        (princ "\nNo output file selected.")
      )
    )
    (princ "\nNo TEXT/LWPOLYLINE entities selected.")
  )
  (princ)
)

(princ "\nSHPEXPORT-bgol.lsp loaded. Type SHPX to export selected entities as shapefile-style GIS data.")
(princ "\n  -- Free & open-source, courtesy of BGol Community (https://bgol.in/) --")
(princ)