;;; ------------------------------------------------------------
;;; INSIMG - Inserta imagen (JPG/PNG/TIF) georreferenciada
;;; usando world file (.jgw/.jpgw/.jpw/.pgw/.tfw/.wld)
;;; Compatible AutoCAD / BricsCAD / ZWCAD (Windows)
;;; Versión 1.3 - 11/08/2025
;;; ------------------------------------------------------------

(vl-load-com)

;; ---------- Utilidades ----------
(defun _jg:str-lower (s) (vl-string-translate "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyz" s))
(defun _jg:path-base (p / ext)
  (setq ext (vl-filename-extension p))
  (substr p 1 (- (strlen p) (if ext (1+ (strlen ext)) 0)))
)

;; ---------- Localizar world file asociado ----------
(defun _jg:find-world (img / base ext folder exts cand f files bname name lowname e)
  (setq base   (_jg:path-base img)
        ext    (_jg:str-lower (vl-filename-extension img))
        folder (vl-filename-directory img))
  (cond
    ((member ext '(".jpg" ".jpeg")) (setq exts '(".jpgw" ".jgw" ".jpw" ".wld")))
    ((member ext '(".png"))         (setq exts '(".pngw" ".pgw" ".wld")))
    ((member ext '(".tif" ".tiff")) (setq exts '(".tifw" ".tfw" ".wld")))
    (t                              (setq exts '(".wld")))
  )
  ;; Intento directo
  (setq cand (mapcar '(lambda (x) (strcat base x)) exts))
  (if (setq f (car (vl-remove-if-not 'findfile cand)))
    f
    (progn
      ;; Búsqueda insensible a may/min en el directorio
      (setq files (vl-directory-files folder nil 1))
      (setq bname (_jg:str-lower (vl-filename-base img)))
      (foreach name files
        (setq lowname (_jg:str-lower name))
        (foreach e exts
          (if (= lowname (strcat bname e))
            (setq f (strcat folder "\\" name))
          )
        )
      )
      (if f
        f
        ;; Selección manual
        (progn
          (prompt "\nNo se encontró el world file asociado automáticamente.")
          (getfiled "Selecciona el world file" folder "jgw;jpgw;jpw;wld;pgw;pngw;tfw;tifw" 0)
        )
      )
    )
  )
)

;; ---------- Leer world file (6 líneas A D B E C F) ----------
(defun _jg:read-world (wfile / fp vals line)
  (if (setq fp (open wfile "r"))
    (progn
      (while (and (setq line (read-line fp)) (< (length vals) 6))
        (setq vals (append vals (list (atof line)))))
      (close fp)
      (if (= (length vals) 6) vals
        (progn (prompt "\nWorld file no válido (se esperaban 6 números).") nil))
    )
    (prompt "\nNo se pudo abrir el world file.")
  )
)

;; ---------- Dimensiones de la imagen (px) ----------
(defun _jg:get-pixels (filepath / img w h rc)
  ;; WIA.ImageFile.LoadFile; devuelve (ancho alto) o NIL si falla.
  (vl-load-com)
  (setq img (vl-catch-all-apply 'vlax-create-object (list "WIA.ImageFile")))
  (if (or (vl-catch-all-error-p img) (null img))
    nil
    (progn
      (setq rc (vl-catch-all-apply 'vlax-invoke (list img 'LoadFile filepath)))
      (if (vl-catch-all-error-p rc)
        (progn (vlax-release-object img) nil)
        (progn
          (setq w (vlax-get-property img 'Width))
          (setq h (vlax-get-property img 'Height))
          (vlax-release-object img)
          (list (fix w) (fix h))
        )
      )
    )
  )
)

;; ---------- Insertar ráster sin escala/rotación ----------
(defun _jg:attach-raw (img / doc ms ins vla ok oldFD oldCD)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq ms  (vla-get-ModelSpace doc))
  (setq ins (vlax-3d-point 0.0 0.0 0.0))
  ;; Preferente: AddRaster (escala 1, rot 0). Fallback: IMAGEATTACH sin diálogo.
  (setq vla (vl-catch-all-apply 'vla-AddRaster (list ms img ins 1 0.0)))
  (if (vl-catch-all-error-p vla)
    (progn
      (setq oldFD (getvar 'FILEDIA)  oldCD (getvar 'CMDDIA))
      (setvar 'FILEDIA 0) (setvar 'CMDDIA 0)
      (setq ok (not (vl-catch-all-error-p
                      (vl-catch-all-apply 'vl-cmdf
                        (list "._IMAGEATTACH" img '(0 0 0) 1 0.0)))))
      (setvar 'FILEDIA oldFD) (setvar 'CMDDIA oldCD)
      (if ok
        (_jg:last-vla)
        (progn (prompt "\nNo se pudo insertar la imagen (AddRaster/IMAGEATTACH).") nil)
      )
    )
    vla
  )
)

(defun _jg:last-vla ( / e) (if (setq e (entlast)) (vlax-ename->vla-object e)))

;; ---------- Fijar InsertionPoint y U/V por píxel ----------
(defun _jg:set-ip-and-uv-perpixel (v ip A D B E / ent dxf rc Bv Ev)
  (setq Bv (- B)  Ev (- E))  ;; <- invertir V para que apunte "hacia arriba"
  ;; ActiveX (preferente)
  (setq rc
    (vl-catch-all-apply
      '(lambda ()
         (vlax-put-property v 'InsertionPoint (vlax-3d-point (list (car ip) (cadr ip) 0.0)))
         (vlax-put-property v 'UVector         (vlax-3d-point (list A  D  0.0)))  ; por píxel
         (vlax-put-property v 'VVector         (vlax-3d-point (list Bv Ev 0.0)))  ; por píxel, invertido
       )))
  (if (vl-catch-all-error-p rc)
    (progn
      ;; Fallback DXF: 10=IP, 11=U(pix), 12=V(pix) invertido
      (setq ent (vlax-vla-object->ename v)
            dxf (entget ent))
      (setq dxf (subst (cons 10 (list (car ip) (cadr ip) 0.0)) (assoc 10 dxf) dxf))
      (if (assoc 11 dxf)
        (setq dxf (subst (cons 11 (list A D 0.0)) (assoc 11 dxf) dxf))
        (setq dxf (append dxf (list (cons 11 (list A D 0.0))))))
      (if (assoc 12 dxf)
        (setq dxf (subst (cons 12 (list Bv Ev 0.0)) (assoc 12 dxf) dxf))
        (setq dxf (append dxf (list (cons 12 (list Bv Ev 0.0))))))
      (entmod dxf) (entupd ent)
    )
  )
)

;; ---------- Comando principal ----------
(defun c:INSIMG (/ img wld vals A D B E C F
                      px cols rows
                      u vvec ul ll
                      vla widthU heightU)

  ;; 1) Selección de imagen
  (setq img (getfiled "Selecciona imagen (JPG/PNG/TIF)" "" "jpg;jpeg;png;tif;tiff" 0))
  (if (not img) (progn (prompt "\nCancelado.") (princ)))

  ;; 2) World file asociado
  (setq wld (_jg:find-world img))
  (if (not wld) (progn (prompt "\nNo hay world file. Cancelado.") (princ)))

  ;; 3) Leer A D B E C F
  (setq vals (_jg:read-world wld))
  (if (not vals) (progn (prompt "\nWorld file inválido. Cancelado.") (princ)))
  (setq A (nth 0 vals)  D (nth 1 vals)
        B (nth 2 vals)  E (nth 3 vals)
        C (nth 4 vals)  F (nth 5 vals))

  ;; 4) Dimensiones de la imagen (px)
  (setq px (_jg:get-pixels img))
  (if (not px)
    (progn
      (prompt "\nNo fue posible leer tamaño con WIA. Introduce dimensiones manualmente.")
      (setq cols (getint "\nAncho (px): ")
            rows (getint "\nAlto  (px): "))
    )
    (progn (setq cols (car px) rows (cadr px)))
  )

  ;; 5) Vectores por píxel y vértices
  ;; U(pix) = (A,D), V(pix) = (B,E)
  ;; UL: de (C,F) (centro del píxel UL) a esquina UL
  (setq ul (list (- C (* 0.5 A) (* 0.5 B))
                 (- F (* 0.5 D) (* 0.5 E))))
  ;; Vtotal = rows * V(pix)
  (setq vvec (list (* B rows) (* E rows)))
  ;; LL = UL + Vtotal   (¡ojo al signo!)
  (setq ll (list (+ (car ul) (car vvec))
                 (+ (cadr ul) (cadr vvec))))

  ;; 6) Insertar crudo y fijar IP + U/V por píxel
  (setq vla (_jg:attach-raw img))
  (if (not vla) (progn (prompt "\nFallo al insertar imagen.") (princ)))
  (_jg:set-ip-and-uv-perpixel vla ll A D B E)

  ;; 7) Opciones de visualización
  (vl-catch-all-apply 'setvar (list 'imageframe 1))
  (command "_.ZOOM" "_Object" (vlax-vla-object->ename vla) "")

  ;; 8) Resultado
  (setq widthU  (* (sqrt (+ (* A A) (* D D))) cols))
  (setq heightU (* (sqrt (+ (* B B) (* E E))) rows))
  (prompt (strcat
    "\nGeorreferencia: " (vl-filename-base wld) (vl-filename-extension wld)
    "\nFilas x Columnas: " (itoa cols) " x " (itoa rows)
    "\nPunto de inserción: (" (rtos (car ll) 2 4) ", " (rtos (cadr ll) 2 4) ")"
  ))
  (princ)
)

(princ "\nComando cargado: INSIMG")
(princ)