;;; ==========================================================================
;;; interprete_de_capas.lsp - Exportador de Capas a CSV para AutoCAD
;;; Autor: arqMANES
;;; Versión: 1.00
;;; ==========================================================================
;;; Comando en AutoCAD: INTERPRETE_CAPAS_CSV-ARQMANES
;;;
;;; Descripción:
;;; Lee todas las capas creadas en el archivo DWG activo (excluyendo "0" y
;;; "Defpoints") y genera un archivo CSV con sus propiedades formateado
;;; según la plantilla de capas 4.1. El CSV se guarda automáticamente en la
;;; carpeta de Descargas del usuario actual con el mismo nombre del dibujo.
;;; ==========================================================================

(vl-load-com)

;;; --------------------------------------------------------------------------
;;; Utilidades de Conversión y Escape de Texto
;;; --------------------------------------------------------------------------

;; Convierte cualquier valor a string de forma segura
(defun val-to-string (val)
  (if (= (type val) 'VARIANT)
    (setq val (vlax-variant-value val))
  )
  (if (or (null val) (= val "") (= val "nil"))
    ""
    (vl-string-trim " \t\r\n" (vl-princ-to-string val))
  )
)

;; Convierte un carácter hexadecimal a su valor entero (para decodificar Unicode)
(defun hex-char-to-int (char / code)
  (setq code (ascii (strcase char)))
  (cond
    ((and (>= code 48) (<= code 57)) (- code 48)) ; '0'-'9'
    ((and (>= code 65) (<= code 70)) (- code 55)) ; 'A'-'F'
    (t 0)
  )
)

;; Convierte una cadena hexadecimal a un número entero
(defun hex-to-int (str / val len i)
  (setq val 0
        len (strlen str)
        i 1
  )
  (while (<= i len)
    (setq val (+ (* val 16) (hex-char-to-int (substr str i 1))))
    (setq i (1+ i))
  )
  val
)

;; Obtiene la representación de caracteres o bytes UTF-8 según el motor AutoLISP activo
(defun get-chr (cp / sys)
  (setq sys (cond ((getvar "LISPSYS")) (t 0)))
  (if (> sys 0)
    ;; AutoCAD Moderno (LISPSYS > 0): Usamos chr unicode nativo
    (chr cp)
    ;; AutoCAD Antiguo o LISPSYS = 0: Traducimos el codepoint a bytes UTF-8
    (cond
      ((< cp 128)
       (chr cp)
      )
      ((< cp 2048)
       (strcat (chr (+ 192 (/ cp 64)))
               (chr (+ 128 (rem cp 64)))
       )
      )
      (t
       (strcat (chr (+ 224 (/ cp 4096)))
               (chr (+ 128 (rem (/ cp 64) 64)))
               (chr (+ 128 (rem cp 64)))
       )
      )
    )
  )
)

;; Decodifica las secuencias de escape unicode \U+XXXX en caracteres reales (ej: \U+0410 -> А)
(defun decode-unicode-string (str / pos result hex codepoint rem)
  (setq result ""
        rem str
  )
  (while (and rem (/= rem ""))
    (if (and (setq pos (vl-string-search "\\U+" rem))
             (>= (strlen rem) (+ pos 7)) ; Asegura que haya 4 caracteres hex después de \U+
        )
      (progn
        (setq result (strcat result (substr rem 1 pos)))
        (setq hex (substr rem (+ pos 4) 4))
        (setq codepoint (hex-to-int hex))
        (setq result (strcat result (get-chr codepoint)))
        (setq rem (substr rem (+ pos 8)))
      )
      (progn
        (setq result (strcat result rem))
        (setq rem "")
      )
    )
  )
  result
)

;; Escapa caracteres especiales en un campo CSV según el estándar (RFC 4180)
(defun escape-csv-field (str / len i char result hasSpecial)
  (setq len (strlen str)
        i 1
        result ""
        hasSpecial nil
  )
  (while (<= i len)
    (setq char (substr str i 1))
    (cond
      ((= char "\"")
       (setq result (strcat result "\"\""))
       (setq hasSpecial t)
      )
      ((or (= char ";") (= char "\n") (= char "\r"))
       (setq result (strcat result char))
       (setq hasSpecial t)
      )
      (t
       (setq result (strcat result char))
      )
    )
    (setq i (1+ i))
  )
  (if hasSpecial
    (strcat "\"" result "\"")
    str
  )
)

;;; --------------------------------------------------------------------------
;;; Extracción de Propiedades de Capa
;;; --------------------------------------------------------------------------

;; Obtiene el color de la capa formateado en ACI (1-255) o RGB (R,G,B)
(defun get-layer-color-string (layerObj / layerName nameEname elist g420 rgbVal r g b g62)
  (setq layerName (vla-get-name layerObj))
  (setq nameEname (tblobjname "layer" layerName))
  (if nameEname
    (progn
      (setq elist (entget nameEname))
      (setq g420 (assoc 420 elist))
      (if g420
        (progn
          (setq rgbVal (cdr g420))
          ;; Extraer R, G, B mediante divisiones enteras
          (setq r (/ rgbVal 65536))
          (setq g (/ (- rgbVal (* r 65536)) 256))
          (setq b (- rgbVal (* r 65536) (* g 256)))
          (strcat (itoa r) "," (itoa g) "," (itoa b))
        )
        (progn
          (setq g62 (assoc 62 elist))
          (itoa (abs (cdr g62)))
        )
      )
    )
    (itoa (vla-get-color layerObj))
  )
)

;; Obtiene el grosor de línea de la capa formateado en milímetros (ej: 0.35 o vacío para Default)
(defun get-layer-lineweight-string (layerObj / lw)
  (setq lw (vla-get-lineweight layerObj))
  (if (< lw 0)
    "" ; Default / ByLayer
    (vl-string-translate "." "," (rtos (/ (float lw) 100.0) 2 2))
  )
)

;; Divide un nombre de capa en hasta 5 términos basados en delimitadores (-, _, !) y bloques entre paréntesis (...)
;; Retorna una lista de 5 strings: (term1 term2 term3 term4 term5)
(defun split-layer-name-to-terms (name / result current len i char pos closePos parenStr)
  (setq result nil
        current ""
        len (strlen name)
        i 1
  )
  (while (<= i len)
    (setq char (substr name i 1))
    (cond
      ;; 1. Si encontramos un paréntesis de apertura '('
      ((= char "(")
       ;; Si hay texto acumulado en el término actual, lo agregamos a la lista
       (if (/= current "")
         (progn
           (setq result (append result (list current)))
           (setq current "")
         )
       )
       ;; Buscar el paréntesis de cierre ')' en el resto del nombre
       (setq closePos (vl-string-search ")" name i)) ; i es el índice 1-based del '('
       (if closePos
         (progn
           ;; Extraemos todo el contenido incluyendo los paréntesis
           (setq parenStr (substr name i (- (+ closePos 2) i)))
           (setq result (append result (list parenStr)))
           ;; Avanzamos el índice i hasta después del paréntesis de cierre
           (setq i (+ closePos 2))
         )
         (progn
           ;; Si no hay un paréntesis de cierre correspondiente, lo tratamos como texto normal
           (setq current (strcat current char))
           (setq i (1+ i))
         )
       )
      )
      
      ;; 2. Si encontramos un delimitador (!, _, o -)
      ((or (= char "!") (= char "_") (= char "-"))
       ;; El delimitador se incluye al final del término actual
       (setq current (strcat current char))
       (setq result (append result (list current)))
       (setq current "")
       (setq i (1+ i))
      )
      
      ;; 3. Acumular cualquier otro carácter ordinario
      (t
       (setq current (strcat current char))
       (setq i (1+ i))
      )
    )
  )
  ;; Si al terminar el bucle queda algo acumulado, lo agregamos
  (if (/= current "")
    (setq result (append result (list current)))
  )
  
  ;; Limpiar términos vacíos y rellenar la lista hasta 5 elementos
  (setq result (vl-remove "" result))
  (while (< (length result) 5)
    (setq result (append result '("")))
  )
  result
)

;; Obtiene la transparencia de la capa de forma segura (nativa o por fallback DXF 440)
(defun get-layer-transparency (layerName / val elist g440 alpha percent)
  (cond
    ((type getpropertyvalue)
     (setq elist (tblobjname "layer" layerName))
     (if elist
       (progn
         (setq val (vl-catch-all-apply 'getpropertyvalue (list elist "Transparency")))
         (if (or (vl-catch-all-error-p val) (< val 0)) 0 val)
       )
       0
     )
    )
    (t
     (setq elist (tblobjname "layer" layerName))
     (if elist
       (progn
         (setq elist (entget elist))
         (setq g440 (assoc 440 elist))
         (if g440
           (progn
             (setq val (cdr g440))
             ;; En AutoCAD DXF, la transparencia es 0x02000000 + alpha (255 = opaco, 0 = transparente)
             (setq alpha (logand val 255))
             (setq percent (fix (- 100 (/ (* alpha 100) 255))))
             (if (< percent 0) 0 percent)
           )
           0
         )
       )
       0
     )
    )
  )
)

;;; --------------------------------------------------------------------------
;;; Comando Principal: INTERPRETE_CAPAS_CSV-ARQMANES
;;; --------------------------------------------------------------------------

(defun c:INTERPRETE_CAPAS_CSV-ARQMANES ( / dwgName dwgBase userProfile csvPath file doc layers name nameUpper term1 term2 term3 term4 term5 plot color ltype thickness transparency finalName desc lineStr count oldDimzin terms sys bom nameRaw)
  (vl-load-com)
  (princ "\n--- Iniciando Intérprete de Capas (Exportador a CSV v1.00) ---")
  
  ;; Guardar variables de sistema y configurar formato de números (conservar decimales)
  (setq oldDimzin (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  
  ;; Obtener nombre del dibujo y base
  (setq dwgName (getvar "DWGNAME"))
  (setq dwgBase (vl-filename-base dwgName))
  
  ;; Determinar la ruta de descargas del usuario en Windows de forma dinámica
  (setq userProfile (getenv "USERPROFILE"))
  (if (and userProfile (/= userProfile ""))
    (progn
      (if (/= (substr userProfile (strlen userProfile) 1) "\\")
        (setq userProfile (strcat userProfile "\\"))
      )
      (setq csvPath (strcat userProfile "Downloads\\" dwgBase ".csv"))
    )
    ;; Fallback en caso de fallo de variable de entorno
    (setq csvPath (strcat "C:\\Users\\Sergio\\Downloads\\" dwgBase ".csv"))
  )
  
  (arqmanes-log-debug (strcat "\n[DEBUG] Intentando crear el archivo: " csvPath))
  
  ;; Determinar soporte de Unicode y escribir BOM para que Excel detecte UTF-8
  (setq file nil)
  (setq sys (cond ((getvar "LISPSYS")) (t 0)))
  (if (> sys 0)
    (setq file (vl-catch-all-apply 'open (list csvPath "w" "utf8")))
  )
  (if (or (null file) (vl-catch-all-error-p file))
    (progn
      (setq file (open csvPath "w"))
      (setq bom (strcat (chr 239) (chr 187) (chr 191))) ; UTF-8 BOM en modo ANSI (0xEF, 0xBB, 0xBF)
    )
    (setq bom (chr 65279)) ; UTF-8 BOM en modo Unicode (U+FEFF)
  )
  
  (if file
    (progn
      ;; Escribir la cabecera exacta de la plantilla 4.1 con el BOM al inicio
      (write-line (strcat bom "1º TERMINO;2º TERMINO;3º TERMINO;4º TERMINO;5º TERMINO;IMPRIMIR;COLOR;TIPO_DE_LINEA;ESPESOR;TRANSP;Así queda el nombre;DESCRIPCIÓN") file)
      
      (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq layers (vla-get-Layers doc))
      (setq count 0)
      
      (vlax-for layer layers
        (setq nameRaw (vla-get-name layer))
        (setq name (decode-unicode-string nameRaw))
        (setq nameUpper (strcase name))
        
        ;; Omitir las capas por defecto "0" y "Defpoints"
        (if (and (/= nameUpper "0") (/= nameUpper "DEFPOINTS"))
          (progn
            ;; Separar el nombre en hasta 5 términos basados en delimitadores
            (setq terms (split-layer-name-to-terms name)
                  term1 (nth 0 terms)
                  term2 (nth 1 terms)
                  term3 (nth 2 terms)
                  term4 (nth 3 terms)
                  term5 (nth 4 terms)
                  plot (if (= (vla-get-plottable layer) :vlax-true) "SI" "NO")
                  color (get-layer-color-string layer)
                  ltype (vla-get-linetype layer)
                  thickness (get-layer-lineweight-string layer)
                  transparency (itoa (get-layer-transparency nameRaw))
                  finalName (strcat "=A" (itoa (+ count 2)) "&B" (itoa (+ count 2)) "&C" (itoa (+ count 2)) "&D" (itoa (+ count 2)) "&E" (itoa (+ count 2)))
            )
            
            ;; Obtener la descripción de forma segura
            (setq desc (vl-catch-all-apply 'vla-get-description (list layer)))
            (if (vl-catch-all-error-p desc)
              (setq desc "")
              (setq desc (decode-unicode-string desc))
            )
            
            ;; Escapar y formatear línea del CSV
            (setq lineStr (strcat (escape-csv-field term1) ";"
                                  (escape-csv-field term2) ";"
                                  (escape-csv-field term3) ";"
                                  (escape-csv-field term4) ";"
                                  (escape-csv-field term5) ";"
                                  (escape-csv-field plot) ";"
                                  (escape-csv-field color) ";"
                                  (escape-csv-field ltype) ";"
                                  (escape-csv-field thickness) ";"
                                  (escape-csv-field transparency) ";"
                                  (escape-csv-field finalName) ";"
                                  (escape-csv-field desc)))
            
            (write-line lineStr file)
            (setq count (1+ count))
          )
        )
      )
      
      (close file)
      (princ (strcat "\n[OK] ¡Exportación completada! Se exportaron " (itoa count) " capas correctamente."))
      (princ (strcat "\nArchivo guardado en: " csvPath))
    )
    (princ (strcat "\n[ERROR] No se pudo crear o escribir en el archivo: " csvPath))
  )
  (if oldDimzin (setvar "DIMZIN" oldDimzin))
  (princ)
)

;; Función helper para debug (si no está definida en otra rutina cargada)
(if (not arqmanes-log-debug)
  (defun arqmanes-log-debug (msg)
    ;; Por defecto silencioso, descomentar para depuración:
    ;; (princ msg)
    (princ)
  )
)

(princ "\nCarga exitosa. Escriba 'INTERPRETE_CAPAS_CSV-ARQMANES' en la línea de comandos de AutoCAD para exportar sus capas a CSV en su carpeta de descargas.")
(princ)