;;; ===================================================
;;; ANNO-SCALE-MANAGER.lsp  (v1.3)
;;; Gestión de Escalas Anotativas para AutoCAD
;;; ---------------------------------------------------
;;; Comandos:
;;;   ASM      - Menú principal de gestión de escalas
;;;   ASM-INFO - Diagnóstico: lista escalas y claves
;;;
;;; Cómo cargar:
;;;   APPLOAD > seleccioná este archivo, o arrastralo
;;;   directamente al área de dibujo de AutoCAD.
;;; ===================================================

(vl-load-com)

;;---------------------------------------------------
;; ACCESO AL DICCIONARIO DE ESCALAS
;;---------------------------------------------------

(defun _asm:scale-dict-ename (/ nod result)
  (setq nod (namedobjdict))
  (cond
    ((setq result (dictsearch nod "ACAD_SCALELIST"))
     (cdr (assoc -1 result)))
    ((setq result (dictsearch nod "ACDB_ANNOTATIONSCALES"))
     (cdr (assoc -1 result)))
    ((setq result (dictsearch nod "AcDbScales"))
     (cdr (assoc -1 result)))
    (T nil)
  )
)

;;---------------------------------------------------
;; FUNCIÓN: _asm:all-scales
;; Retorna lista de pares (nombre_real . ename) de todas
;; las escalas leyendo el diccionario y los objetos.
;;---------------------------------------------------
(defun _asm:all-scales (/ dictEname dictData result pair key ename objData scaleName)
  (setq dictEname (_asm:scale-dict-ename))
  (if dictEname
    (progn
      (setq dictData (entget dictEname))
      (foreach pair dictData
        (cond
          ((= (car pair) 3) (setq key (cdr pair)))
          ((and key (or (= (car pair) 350) (= (car pair) 360)))
           (setq ename (cdr pair))
           ;; Obtenemos la data del objeto escala para leer su nombre real (grupo 300)
           (if (setq objData (entget ename))
             (if (setq scaleName (cdr (assoc 300 objData)))
               (setq result (cons (cons scaleName ename) result))
               ;; Fallback: usar el key del diccionario si no tiene grupo 300
               (setq result (cons (cons key ename) result))
             )
           )
           (setq key nil)
          )
        )
      )
      (reverse result)
    )
  )
)

;;---------------------------------------------------
;; UTILIDADES
;;---------------------------------------------------

(defun _asm:doc ()
  (vla-get-activedocument (vlax-get-acad-object))
)

(defun _asm:active ()
  (getvar "CANNOSCALE")
)

(defun _asm:exists-p (scaleName)
  (not (null (assoc scaleName (_asm:all-scales))))
)

;; Borra una escala por su entity name
(defun _asm:delete-scale (scaleEname / res)
  (setq res
    (vl-catch-all-apply
      'vla-delete
      (list (vlax-ename->vla-object scaleEname))
    )
  )
  ;; NOTA: Se ha eliminado la llamada de respaldo a 'entdel'
  ;; porque forzar el borrado de una escala en uso 
  ;; corrompe el dibujo, provocando Fatal Errors.
  (not (vl-catch-all-error-p res))
)

;; Agrega la escala 1:1 (si no existe) y la activa
(defun _asm:ensure-11 (/ saved-cmdecho)
  ;; Intentamos activarla directamente. Si funciona, ya existe y está disponible.
  (if (vl-catch-all-error-p (vl-catch-all-apply 'setvar (list "CANNOSCALE" "1:1")))
    (progn
      ;; Si falla, verificamos si realmente no existe en la lista para crearla
      (if (not (_asm:exists-p "1:1"))
        (progn
          (setq saved-cmdecho (getvar "CMDECHO"))
          (setvar "CMDECHO" 0)
          (command "_.-SCALELISTEDIT" "_Add" "1:1" "1:1" "_Exit")
          (setvar "CMDECHO" saved-cmdecho)
        )
      )
      ;; Intentamos activarla de nuevo por si se creo con otro sufijo o ya existía internamente
      (vl-catch-all-apply 'setvar (list "CANNOSCALE" "1:1"))
    )
  )
)

;;---------------------------------------------------
;; OPCIÓN 1 — Borrar escalas NO USADAS (Purgar)
;;---------------------------------------------------
(defun _asm:opcion-1 (/ prevScale scalesBefore scalesAfter deletedScales)
  (setq prevScale (_asm:active))
  (princ "\n  -> Ejecutando purga de escalas no utilizadas...")
  (princ "\n     AutoCAD analiza el dibujo y elimina las que no")
  (princ "\n     estan asignadas a ningun objeto anotativo.")
  
  (setq scalesBefore (mapcar 'car (_asm:all-scales)))
  (command "_.-SCALELISTEDIT" "_Delete" "*" "_Exit")
  (setq scalesAfter (mapcar 'car (_asm:all-scales)))
  
  (setq deletedScales '())
  (foreach s scalesBefore
    (if (not (member s scalesAfter))
      (setq deletedScales (cons s deletedScales))
    )
  )

  (if (not (_asm:exists-p prevScale))
    (progn
      (princ (strcat "\n  ! La escala activa '" prevScale "' fue eliminada."))
      (cond
        ((_asm:exists-p "1:1")
         (setvar "CANNOSCALE" "1:1")
         (princ "\n  OK Escala '1:1' establecida como activa."))
        (T
         (princ "\n  ! Establece manualmente la escala activa (CANNOSCALE)."))
      )
    )
    (princ (strcat "\n  OK Escala activa '" prevScale "' conservada."))
  )
  (if (> (length deletedScales) 0)
    (progn
      (princ (strcat "\n  OK " (itoa (length deletedScales)) " escala(s) purgada(s):"))
      (foreach s (reverse deletedScales)
        (princ (strcat "\n     - " s))
      )
    )
    (princ "\n  OK Ninguna escala fue purgada (todas estan en uso).")
  )
  (princ "\n  OK Purga completada.")
)

;;---------------------------------------------------
;; OPCIÓN 2 — Borrar TODAS menos la activa
;;---------------------------------------------------
(defun _asm:opcion-2 (/ doc activeScale allScales pair deletedScales)
  (setq doc         (_asm:doc)
        activeScale (_asm:active))
  (vla-StartUndoMark doc)

  (princ (strcat "\n  -> Conservando solo la escala activa: '" activeScale "'"))
  (princ "\n  -> Eliminando el resto...")
  (setq allScales (_asm:all-scales)
        deletedScales '())
  (foreach pair allScales
    (if (/= (car pair) activeScale)
      (if (_asm:delete-scale (cdr pair))
        (setq deletedScales (cons (car pair) deletedScales))
      )
    )
  )

  (vla-EndUndoMark doc)
  (if (> (length deletedScales) 0)
    (progn
      (princ (strcat "\n  OK " (itoa (length deletedScales)) " escala(s) eliminada(s):"))
      (foreach s (reverse deletedScales)
        (princ (strcat "\n     - " s))
      )
    )
    (princ "\n  OK Ninguna escala fue eliminada.")
  )
  (princ (strcat "\n  OK Solo la escala '" activeScale "' permanece en la lista."))
)

;;---------------------------------------------------
;; OPCIÓN 3 — Borrar TODAS las escalas + crear 1:1
;;---------------------------------------------------
(defun _asm:opcion-3 (/ doc allScales pair deletedScales)
  (setq doc (_asm:doc))
  (vla-StartUndoMark doc)

  (princ "\n  -> Verificando/creando escala '1:1' (1 UD = 1 Paper Unit)...")
  (_asm:ensure-11)

  (princ "\n  -> Eliminando el resto de escalas...")
  (setq allScales (_asm:all-scales)
        deletedScales '())
  (foreach pair allScales
    (if (/= (car pair) "1:1")
      (if (_asm:delete-scale (cdr pair))
        (setq deletedScales (cons (car pair) deletedScales))
      )
    )
  )

  (vla-EndUndoMark doc)
  (if (> (length deletedScales) 0)
    (progn
      (princ (strcat "\n  OK " (itoa (length deletedScales)) " escala(s) eliminada(s):"))
      (foreach s (reverse deletedScales)
        (princ (strcat "\n     - " s))
      )
    )
    (princ "\n  OK Ninguna escala fue eliminada.")
  )
  (princ "\n  OK Escala '1:1' es la unica escala anotativa activa.")
)

;;---------------------------------------------------
;; DIAGNÓSTICO — Comando: ASM-INFO
;; Muestra las escalas detectadas y la clave usada.
;; Si falla, lista todas las claves del diccionario
;; principal para ayudar a identificar la correcta.
;;---------------------------------------------------
(defun C:ASM-INFO (/ dictEname allScales pair nodData allKeys k)
  (vl-load-com)
  (princ "\n-----------------------------------")
  (princ "\n[ASM-INFO] Diagnostico de escalas")
  (princ "\n-----------------------------------")
  (princ (strcat "\n  CANNOSCALE (activa): " (_asm:active)))

  (setq dictEname (_asm:scale-dict-ename))
  (if (null dictEname)
    (progn
      (princ "\n\n  X No se encontro el diccionario de escalas.")
      (princ "\n  Claves disponibles en Named Objects Dictionary:")
      ;; Leer las claves directamente del entget del diccionario
      (setq nodData (entget (namedobjdict))
            allKeys '())
      (foreach pair nodData
        (if (= (car pair) 3)
          (setq allKeys (cons (cdr pair) allKeys))
        )
      )
      (setq allKeys (reverse allKeys))
      (foreach k allKeys
        (princ (strcat "\n    - " k))
      )
      (princ "\n\n  -> Busca en la lista la clave relacionada con")
      (princ "\n     escalas y comunicala para ajustar la rutina.")
    )
    (progn
      (setq allScales (_asm:all-scales))
      (princ (strcat "\n\n  OK Diccionario encontrado ("
                     (itoa (length allScales))
                     " escalas):"))
      (foreach pair allScales
        (princ (strcat "\n    - " (car pair)))
      )
      (princ "\n\n  OK La rutina ASM funcionara correctamente.")
    )
  )
  (princ "\n-----------------------------------")
  (princ "\n")
  (princ)
)

;;---------------------------------------------------
;; MENÚ PRINCIPAL — Comando: ASM
;;---------------------------------------------------
(defun C:ASM (/ opcion)
  (vl-load-com)
  (princ "\n")
  (princ "\n +=========================================+")
  (princ "\n |   GESTOR DE ESCALAS ANOTATIVAS  [ASM]  |")
  (princ "\n +=========================================+")
  (princ "\n |  1 - Borrar escalas NO USADAS (Purgar) |")
  (princ "\n |  2 - Borrar TODAS menos la activa      |")
  (princ "\n |  3 - Borrar TODAS y crear escala 1:1   |")
  (princ "\n |  0 - Cancelar                          |")
  (princ "\n +=========================================+")
  (princ (strcat "\n  Escala activa: " (_asm:active)))
  (setq opcion (getstring "\n\n  Ingresa una opcion (0-3): "))
  (princ "\n")
  (cond
    ((= opcion "1") (_asm:opcion-1))
    ((= opcion "2") (_asm:opcion-2))
    ((= opcion "3") (_asm:opcion-3))
    ((= opcion "0") (princ "\n  Operacion cancelada."))
    (T              (princ "\n  Opcion no valida. Escribi 1, 2, 3 o 0."))
  )
  (princ "\n")
  (princ)
)

(princ "\n[ASM] Rutina v1.3 cargada.")
(princ "\n      -> Ejecuta ASM-INFO primero para verificar compatibilidad.")
(princ "\n      -> Luego usa ASM para el menu principal.")
(princ)

;;; ===================================================
;;; Fin de ANNO-SCALE-MANAGER.lsp  (v1.3)
;;; ===================================================