;;; ============================================================
;;;  XRBIND.lsp  Ч  ¬нешние ссылки AutoCAD: внедрение / ремонт
;;;  AutoCAD 2025/2026.  Dionis / ќлег.
;;;   оманды:
;;;    XRBIND    Ч внедрить ¬—≈ –ј«–≈Ў®ЌЌџ≈ ссылки в активном чертеже
;;;    XRBIND1   Ч внедрить одну ссылку (спросит им¤)
;;;    XRLIST    Ч список ссылок со статусом, без изменений чертежа
;;;    XRPATH    Ч сменить путь битой ссылки (указать, где лежит файл)
;;;    XRUNBIND  Ч ќ“—ќ≈ƒ»Ќ»“№ только неразрешЄнные (битые) ссылки
;;;    XRDETACH  Ч отсоединить ¬—≈ ссылки (с подтверждением)
;;;  ќтчЄт: %TEMP%\xrbind_report.txt
;;; ============================================================

(setq *xrb-log* (strcat (getenv "TEMP") "\\xrbind_report.txt"))

;; ---- список имЄн внешних ссылок (пор¤док как в чертеже) ----
(defun xrb-xref-names (doc / lst)
  (setq lst nil)
  (vlax-for b (vla-get-Blocks doc)
    (if (= (vla-get-IsXRef b) :vlax-true)
      (setq lst (cons (vla-get-Name b) lst))))
  (reverse lst))

;; ---- разрешена ли ссылка: бит 32 в флагах блока ----
(defun xrb-resolved-p (nm / e fl)
  (setq e (entget (tblobjname "BLOCK" nm)))
  (if e
    (progn (setq fl (cdr (assoc 70 e)))
           (if (= 32 (logand 32 fl)) T nil))
    nil))

;; ---- это вообще xref-блок? (бит 4) ----
(defun xrb-isxref-p (nm / e fl)
  (setq e (entget (tblobjname "BLOCK" nm)))
  (if e
    (progn (setq fl (cdr (assoc 70 e)))
           (if (= 4 (logand 4 fl)) T nil))
    nil))

(defun xrb-w (f s) (write-line s f))
(defun xrb-pr (s) (princ (strcat "\n" s)))

;; ============================================================
;;  XRLIST Ч отчЄт по ссылкам (без изменений чертежа)
;; ============================================================
(defun c:XRLIST ( / doc names nm f n res tot)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq f (open *xrb-log* "w"))
  (xrb-w f (strcat "ќтчЄт по внешним ссылкам   " (vla-get-Name doc)))
  (xrb-w f (strcat "ѕолный путь: " (vla-get-FullName doc)))
  (xrb-w f "-----------------------------------------------")
  (setq names (xrb-xref-names doc))
  (setq tot (length names) n 0)
  (foreach nm names
    (setq n (1+ n))
    (setq res (if (xrb-resolved-p nm) "–ј«–≈Ў≈Ќј" "Ќ≈ –ј«–≈Ў≈Ќј"))
    (xrb-w f (strcat (itoa n) ".\t" res "\t" nm)))
  (xrb-w f "-----------------------------------------------")
  (xrb-w f (strcat "¬сего ссылок: " (itoa tot)))
  (close f)
  (xrb-pr (strcat "XRLIST: ссылок " (itoa tot) " -> " *xrb-log*))
  (xrb-pr "XRLIST_DONE"))

;; ============================================================
;;  XRBIND Ч внедрить все разрешЄнные ссылки
;; ============================================================
(defun c:XRBIND ( / doc f names nm before after ok fail skip oldecho oldfiledia)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq f (open *xrb-log* "w"))
  (xrb-w f (strcat "XBIND (внедрение ссылок)   " (vla-get-Name doc)))
  (xrb-w f "-----------------------------------------------")
  (setq oldecho (getvar "CMDECHO"))
  (setq oldfiledia (getvar "FILEDIA"))
  (setvar "CMDECHO" 0)
  (setvar "FILEDIA" 0)

  (setq names (xrb-xref-names doc))
  (setq before (length names))
  (xrb-w f (strcat "—сылок до операции: " (itoa before)))

  (setq ok 0 fail 0 skip 0)
  (foreach nm names
    (if (xrb-resolved-p nm)
      (progn
        ;; ¬Ќ≈ƒ–≈Ќ»≈: им¤ + пустой Enter (без него команда виснет на повторном
        ;; запросе списка имЄн). ѕроверено на реальном комплекте —ѕ»—.
        (command "_.-XREF" "_B" nm "")
        (if (xrb-resolved-p nm)
          (progn (setq fail (1+ fail))
                 (xrb-w f (strcat "Ќ≈ ”ƒјЋќ—№\t" nm)))
          (progn (setq ok (1+ ok))
                 (xrb-w f (strcat "¬Ќ≈ƒ–≈Ќќ\t" nm)))))
      (progn (setq skip (1+ skip))
             (xrb-w f (strcat "ѕ–ќѕ”ў≈Ќј (не разрешена)\t" nm)))))

  (setq after (length (xrb-xref-names doc)))
  (xrb-w f "-----------------------------------------------")
  (xrb-w f (strcat "¬недрено: " (itoa ok)))
  (xrb-w f (strcat "Ќе удалось: " (itoa fail)))
  (xrb-w f (strcat "ѕропущено (битые): " (itoa skip)))
  (xrb-w f (strcat "—сылок осталось: " (itoa after) " (было " (itoa before) ")"))
  (close f)

  (setvar "CMDECHO" oldecho)
  (setvar "FILEDIA" oldfiledia)
  (xrb-pr (strcat "XRBIND: внедрено " (itoa ok) ", не удалось " (itoa fail)
                  ", пропущено " (itoa skip) ", осталось " (itoa after)
                  " -> " *xrb-log*))
  (xrb-pr "XRBIND_DONE"))

;; ============================================================
;;  XRBIND1 Ч внедрить одну ссылку по имени
;; ============================================================
(defun c:XRBIND1 ( / nm oldfiledia)
  (setq nm (getstring T "\n»м¤ внешней ссылки дл¤ внедрени¤: "))
  (if (and nm (/= nm ""))
    (if (xrb-resolved-p nm)
      (progn
        (setq oldfiledia (getvar "FILEDIA"))
        (setvar "FILEDIA" 0)
        (command "_.-XREF" "_B" nm "")
        (setvar "FILEDIA" oldfiledia)
        (if (xrb-resolved-p nm)
          (xrb-pr (strcat "XRBIND1: не удалось внедрить " nm))
          (xrb-pr (strcat "XRBIND1: внедрено " nm))))
      (xrb-pr (strcat "XRBIND1: ссылка не разрешена или не найдена: " nm)))
    (xrb-pr "XRBIND1: им¤ не задано"))
  (xrb-pr "XRBIND1_DONE"))

;; ============================================================
;;  XRPATH Ч сменить путь ссылки (починка Ђпереехавшегої файла)
;; ============================================================
(defun c:XRPATH ( / nm newpath oldfiledia)
  (setq nm (getstring T "\n»м¤ ссылки, которой мен¤ем путь: "))
  (cond
    ((= nm "") (xrb-pr "XRPATH: им¤ пустое"))
    ((not (xrb-isxref-p nm)) (xrb-pr "XRPATH: это не внешн¤¤ ссылка"))
    (T
      (setq newpath (getstring T "\nЌовый полный путь к dwg: "))
      (cond
        ((= newpath "") (xrb-pr "XRPATH: путь пустой Ч не изменЄн"))
        ((not (findfile newpath)) (xrb-pr "XRPATH: файл не найден Ч путь не изменЄн"))
        (T
          (setq oldfiledia (getvar "FILEDIA"))
          (setvar "FILEDIA" 0)
          (command "_.-XREF" "_P" nm newpath "")
          (setvar "FILEDIA" oldfiledia)
          (if (xrb-resolved-p nm)
            (xrb-pr (strcat "XRPATH: ссылка всЄ ещЄ не разрешена: " nm))
            (xrb-pr (strcat "XRPATH: путь обновлЄн, ссылка разрешена: " nm))
          )
        )
      )
    )
  )
  (xrb-pr "XRPATH_DONE")
)

;; ============================================================
;;  XRUNBIND Ч ќ“—ќ≈ƒ»Ќ»“№ только неразрешЄнные (битые) ссылки.
;;  √лавное отличие от Bind: Detach Ќ≈ требует исходного файла,
;;  поэтому берЄт и то, чего на диске нет. »менно этим лечитс¤
;;  чертЄж, который не прив¤зываетс¤ из-за битых вложенных ссылок.
;; ============================================================
(defun c:XRUNBIND ( / doc blks names nm f e ok fail)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq blks (vla-get-Blocks doc))
  (setq f (open *xrb-log* "w"))
  (xrb-w f (strcat "XRUNBIND (отсоединение битых ссылок)   " (vla-get-Name doc)))
  (xrb-w f "-----------------------------------------------")

  ;; ѕ–ќ’ќƒ 1 Ч только чтение: собрать имена Ќ≈разрешЄнных ссылок.
  ;; Ќельз¤ удал¤ть элементы коллекции, пока по ней идЄт vlax-for.
  (setq names nil)
  (vlax-for b blks
    (if (= (vla-get-IsXRef b) :vlax-true)
      (progn
        (setq nm (vla-get-Name b))
        (if (not (xrb-resolved-p nm))
          (setq names (cons nm names))))))
  (setq names (reverse names))
  (xrb-w f (strcat "Ѕитых ссылок найдено: " (itoa (length names))))

  ;; ѕ–ќ’ќƒ 2 Ч удаление по именам
  (setq ok 0 fail 0)
  (foreach nm names
    (setq e (vl-catch-all-apply 'vla-Detach (list (vla-item blks nm))))
    (if (vl-catch-all-error-p e)
      (progn (setq fail (1+ fail))
             (xrb-w f (strcat "ќЎ»Ѕ ј\t" nm "\t" (vl-catch-all-error-message e))))
      (progn (setq ok (1+ ok))
             (xrb-w f (strcat "ќ“—ќ≈ƒ»Ќ≈Ќќ\t" nm)))))

  (xrb-w f "-----------------------------------------------")
  (xrb-w f (strcat "ќтсоединено: " (itoa ok) ", ошибок: " (itoa fail)))
  (close f)
  (xrb-pr (strcat "XRUNBIND: отсоединено " (itoa ok) ", ошибок " (itoa fail)
                  " -> " *xrb-log*))
  (xrb-pr "XRUNBIND_DONE"))

;; ============================================================
;;  XRDETACH Ч отсоединить ¬—≈ ссылки (с подтверждением)
;; ============================================================
(defun c:XRDETACH ( / doc blks names nm f e ok fail ans)
  (initget "ƒа Ќет")
  (setq ans (getkword "\nќтсоединить ¬—≈ внешние ссылки без внедрени¤? [ƒа/Ќет] <Ќет>: "))
  (if (= ans "ƒа")
    (progn
      (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq blks (vla-get-Blocks doc))
      (setq f (open *xrb-log* "w"))
      (xrb-w f (strcat "XRDETACH (отсоединение всех ссылок)   " (vla-get-Name doc)))
      (xrb-w f "-----------------------------------------------")

      (setq names (xrb-xref-names doc))   ; проход 1: чтение
      (setq ok 0 fail 0)
      (foreach nm names                   ; проход 2: удаление
        (setq e (vl-catch-all-apply 'vla-Detach (list (vla-item blks nm))))
        (if (vl-catch-all-error-p e)
          (progn (setq fail (1+ fail))
                 (xrb-w f (strcat "ќЎ»Ѕ ј\t" nm)))
          (progn (setq ok (1+ ok))
                 (xrb-w f (strcat "ќ“—ќ≈ƒ»Ќ≈Ќќ\t" nm)))))
      (xrb-w f "-----------------------------------------------")
      (xrb-w f (strcat "ќтсоединено: " (itoa ok) ", ошибок: " (itoa fail)))
      (close f)
      (xrb-pr (strcat "XRDETACH: отсоединено " (itoa ok) ", ошибок " (itoa fail)
                      " -> " *xrb-log*)))
    (xrb-pr "XRDETACH: отменено"))
  (xrb-pr "XRDETACH_DONE"))

(princ "\nXRBIND.lsp загружен.  оманды: XRBIND  XRBIND1  XRLIST  XRPATH  XRUNBIND  XRDETACH")
(princ)