---

;;; ============================================================
;;; DIMFIX.LSP
;;; Редактирование префикса/суффикса размеров внутри блоков
;;; Данные хранятся в XDATA объекта DIMENSION (переживают
;;; передачу файла другому пользователю).
;;; При изменении геометрии блока реактор автоматически
;;; восстанавливает преф/суфф в новом анонимном блоке *D...
;;;
;;; Команды:
;;;   SETDIMFIX  — кликнуть на цифры размера, ввести преф/суфф
;;;   CLEARDIMFIX — снять преф/суфф с размера
;;; ============================================================

(vl-load-com)

;;; ------------------------------------------------------------
;;; КОНСТАНТЫ
;;; ------------------------------------------------------------
(setq *DIMFIX_APP*      "DIMFIX_APP")   ; имя XDATA-приложения
(setq *DIMFIX_REACTORS* '())            ; список активных реакторов
                                        ; формат: ((handle . reactor) ...)

;;; ============================================================
;;; БЛОК 1: XDATA — чтение и запись
;;; ============================================================

(defun DIMFIX_XDATA_REGISTER ()
  ;; Зарегистрировать APPID если ещё не зарегистрирован
  (if (null (tblsearch "APPID" *DIMFIX_APP*))
    (entmake (list '(0 . "APPID")
                   (cons 2 *DIMFIX_APP*)))))

(defun DIMFIX_XDATA_SAVE (dim_ent pre suf / dxf xdata new_xdata)
  ;; Записать префикс и суффикс в XDATA объекта DIMENSION
  (DIMFIX_XDATA_REGISTER)
  (setq dxf (entget dim_ent (list *DIMFIX_APP*)))
  ;; Удалить старые XDATA нашего приложения если есть
  (setq dxf (vl-remove-if
              '(lambda (x) (= (car x) -3))
              dxf))
  ;; Добавить новые XDATA
  (setq dxf (append dxf
              (list (list -3
                     (list *DIMFIX_APP*
                           (cons 1000 pre)
                           (cons 1000 suf))))))
  (entmod dxf))

(defun DIMFIX_XDATA_LOAD (dim_ent / dxf xdata app_data)
  ;; Прочитать префикс и суффикс из XDATA
  ;; Возвращает (список "префикс" "суффикс") или nil
  (setq dxf (entget dim_ent (list *DIMFIX_APP*)))
  (setq xdata (assoc -3 dxf))
  (if xdata
    (progn
      (setq app_data (cdr (assoc *DIMFIX_APP* (cdr xdata))))
      (if (and app_data (>= (length app_data) 2))
        (list (cdr (car app_data))    ; префикс (1000)
              (cdr (cadr app_data)))  ; суффикс (1000)
        nil))
    nil))

(defun DIMFIX_XDATA_CLEAR (dim_ent / dxf)
  ;; Удалить XDATA с объекта
  (setq dxf (entget dim_ent (list *DIMFIX_APP*)))
  (setq dxf (vl-remove-if '(lambda (x) (= (car x) -3)) dxf))
  (entmod dxf))

;;; ============================================================
;;; БЛОК 2: ОБНОВЛЕНИЕ ТЕКСТА в анонимном блоке *D...
;;; ============================================================

(defun DIMFIX_UPDATE_TEXT (dim_ent pre suf
                           / anon_name anon_def src obj_dxf new_text)
  ;; Записать "преф<>суфф" в TEXT/MTEXT внутри *D... блока
  (setq anon_name (cdr (assoc 2 (entget dim_ent))))
  (if (and anon_name (= (substr anon_name 1 2) "*D"))
    (progn
      (setq anon_def (tblobjname "BLOCK" anon_name))
      (if anon_def
        (progn
          (setq new_text (strcat pre "<>" suf))
          (setq src (entnext anon_def))
          (while (and src
                      (/= (cdr (assoc 0 (entget src))) "ENDBLK"))
            (setq obj_dxf (entget src))
            (if (member (cdr (assoc 0 obj_dxf)) '("TEXT" "MTEXT"))
              (progn
                (entmod (subst (cons 1 new_text)
                               (assoc 1 obj_dxf)
                               obj_dxf))
                (entupd src)))
            (setq src (entnext src))))))))

;;; ============================================================
;;; БЛОК 3: РЕАКТОР на изменение объекта DIMENSION
;;; ============================================================

(defun DIMFIX_CHANGED_CB (reactor params
                          / dim_ent data pre suf)
  ;; Срабатывает при изменении отслеживаемого размера
  (setq dim_ent (vlr-owner reactor))
  (if (and dim_ent (not (vlax-erased-p dim_ent)))
    (progn
      (setq data (DIMFIX_XDATA_LOAD dim_ent))
      (if data
        (progn
          (setq pre (car data))
          (setq suf (cadr data))
          (DIMFIX_UPDATE_TEXT dim_ent pre suf)
          (entupd dim_ent))))))

(defun DIMFIX_ATTACH_REACTOR (dim_ent / handle reactor)
  ;; Повесить персистентный реактор на объект DIMENSION
  ;; если реактор ещё не висит
  (setq handle (cdr (assoc 5 (entget dim_ent))))
  (if (null (assoc handle *DIMFIX_REACTORS*))
    (progn
      (setq reactor
        (vlr-object-reactor
          (list dim_ent)
          *DIMFIX_APP*
          '((:vlr-modified . DIMFIX_CHANGED_CB))))
      (vlr-pers reactor)  ; сохранить реактор в DWG
      (setq *DIMFIX_REACTORS*
            (append *DIMFIX_REACTORS*
                    (list (cons handle reactor)))))))

(defun DIMFIX_DETACH_REACTOR (dim_ent / handle entry reactor)
  ;; Снять реактор с объекта
  (setq handle (cdr (assoc 5 (entget dim_ent))))
  (setq entry (assoc handle *DIMFIX_REACTORS*))
  (if entry
    (progn
      (setq reactor (cdr entry))
      (vlr-pers-release reactor)
      (vlr-remove reactor)
      (setq *DIMFIX_REACTORS*
            (vl-remove entry *DIMFIX_REACTORS*)))))

;;; ============================================================
;;; БЛОК 4: ВОССТАНОВЛЕНИЕ при открытии файла и после REGEN
;;; ============================================================

(defun DIMFIX_RESTORE ( / ss i ent data pre suf)
  ;; Найти все DIMENSION с нашими XDATA и восстановить:
  ;; 1) реакторы
  ;; 2) текст в *D...
  (setq *DIMFIX_REACTORS* '())
  ;; Выбрать все объекты с нашими XDATA
  (setq ss (ssget "_X"
             (list '(0 . "DIMENSION")
                   (cons -3 (list *DIMFIX_APP*)))))
  (if ss
    (progn
      (setq i 0)
      (while (< i (sslength ss))
        (setq ent (ssname ss i))
        (setq data (DIMFIX_XDATA_LOAD ent))
        (if data
          (progn
            (setq pre (car data))
            (setq suf (cadr data))
            ;; Восстановить реактор
            (DIMFIX_ATTACH_REACTOR ent)
            ;; Обновить текст немедленно
            (DIMFIX_UPDATE_TEXT ent pre suf)
            (entupd ent)))
        (setq i (1+ i)))))
  (princ))

;;; Реактор на открытие файла
(vlr-dwg-reactor
  nil
  '((:vlr-endDwgOpen . (lambda (r p) (DIMFIX_RESTORE)))))

;;; Реактор на REGEN — перерисовать все отслеживаемые размеры
(vlr-editor-reactor
  nil
  '((:vlr-commandEnded .
      (lambda (r p)
        (if (member (strcase (car p))
                    '("REGEN" "REGENALL" "REGENVISIBLE"))
          (DIMFIX_RESTORE))))))

;;; ============================================================
;;; БЛОК 5: РАЗБОР КЛИКА — получить DIMENSION из nentsel
;;; ============================================================

(defun DIMFIX_GET_DIM_FROM_CLICK ( / sel path anon_name blk_name
                                     anon_ins blk_ref edxf
                                     blk_def src obj_dxf dim_ent)
  ;; Клик на цифры размера внутри блока
  ;; Возвращает (dim_ent blk_ref) или nil
  (setq sel (nentsel "\nКликните на цифры размера внутри блока: "))
  (if (null sel) (progn (princ "\nОтмена.") nil)
    (progn
      (setq path (caddr sel))
      (setq anon_ins nil  blk_ref nil)

      ;; Разобрать путь вхождений
      (foreach ent path
        (setq edxf (entget ent))
        (cond
          ;; Анонимный блок *D... (размерный)
          ((and (= (cdr (assoc 0 edxf)) "INSERT")
                (= (substr (cdr (assoc 2 edxf)) 1 2) "*D")
                (null anon_ins))
           (setq anon_ins ent
                 anon_name (cdr (assoc 2 edxf))))
          ;; Пользовательский блок (не *)
          ((and (= (cdr (assoc 0 edxf)) "INSERT")
                (/= (substr (cdr (assoc 2 edxf)) 1 1) "*")
                (null blk_ref))
           (setq blk_ref ent
                 blk_name (cdr (assoc 2 edxf))))))

      (if (null anon_ins)
        (progn (princ "\nКликните именно на цифры размера!") nil)
        (progn
          ;; Найти объект DIMENSION в блоке по имени *D...
          (setq blk_def (tblobjname "BLOCK" blk_name))
          (setq src (entnext blk_def)  dim_ent nil)
          (while (and src
                      (/= (cdr (assoc 0 (entget src))) "ENDBLK"))
            (setq obj_dxf (entget src))
            (if (and (= (cdr (assoc 0 obj_dxf)) "DIMENSION")
                     (= (cdr (assoc 2 obj_dxf)) anon_name))
              (setq dim_ent src))
            (setq src (entnext src)))

          (if (null dim_ent)
            (progn (princ "\nDIMENSION не найден в блоке!") nil)
            (list dim_ent blk_ref)))))))

;;; ============================================================
;;; БЛОК 6: АВТОУСТАНОВКА в acaddoc.lsp
;;; ============================================================

(defun DIMFIX_INSTALL ( / lsp_path acaddoc_path f line found load_line)
  (setq lsp_path (findfile "dimfix.lsp"))
  (if (null lsp_path)
    (progn (princ "\nОшибка: не найден файл dimfix.lsp!") (exit)))

  ;; Найти папку поддержки через acad.pat
  (setq support_dir (vl-filename-directory (findfile "acad.pat")))
  (if (null support_dir)
    (progn (princ "\nНе удалось найти папку поддержки AutoCAD!") (exit)))

  (setq acaddoc_path (strcat support_dir "acaddoc.lsp"))

  ;; Строка загрузки (слэши Unix для совместимости)
  (setq lsp_path_fwd
    (vl-string-subst "/" "\\" lsp_path))
  (setq load_line
    (strcat "(if (findfile \""  lsp_path_fwd
            "\") (load \""      lsp_path_fwd "\"))"))

  ;; Проверить — не прописан ли уже
  (setq found nil)
  (if (findfile acaddoc_path)
    (progn
      (setq f (open acaddoc_path "r"))
      (while (setq line (read-line f))
        (if (vl-string-search "dimfix" line)
          (setq found T)))
      (close f)))

  (if found
    (princ "\nDimFix уже установлен в acaddoc.lsp.")
    (progn
      (setq f (open acaddoc_path "a"))
      (write-line ""                              f)
      (write-line ";; === DimFix autoload ==="    f)
      (write-line load_line                       f)
      (close f)
      (princ (strcat "\nDimFix установлен в: " acaddoc_path))
      (princ "\nПри следующем запуске AutoCAD загрузится автоматически.")))
  (princ))

;;; Запустить установку при первой загрузке файла
(if (null *DIMFIX_INSTALLED*)
  (progn
    (DIMFIX_INSTALL)
    (setq *DIMFIX_INSTALLED* T)))

;;; ============================================================
;;; КОМАНДА: SETDIMFIX — установить преф/суфф на размер
;;; ============================================================

(defun c:SETDIMFIX ( / result dim_ent blk_ref cur_data
                       cur_pre cur_suf new_pre new_suf)

  (setq result (DIMFIX_GET_DIM_FROM_CLICK))
  (if (null result) (exit))

  (setq dim_ent (car result))
  (setq blk_ref (cadr result))

  ;; Показать текущие значения
  (setq cur_data (DIMFIX_XDATA_LOAD dim_ent))
  (setq cur_pre  (if cur_data (car cur_data)  ""))
  (setq cur_suf  (if cur_data (cadr cur_data) ""))

  (princ (strcat "\nРазмер: "
                 (rtos (cdr (assoc 42 (entget dim_ent))) 2 2)))
  (princ (strcat "\nПреф: \""  cur_pre
                 "\"  Суфф: \"" cur_suf "\""))

  ;; Запросить новые значения
  (setq new_pre
    (getstring T (strcat "\nПрефикс [" cur_pre
                          "] (Enter = без изменений): ")))
  (setq new_suf
    (getstring T (strcat "\nСуффикс [" cur_suf
                          "] (Enter = без изменений): ")))
  (if (= new_pre "") (setq new_pre cur_pre))
  (if (= new_suf "") (setq new_suf cur_suf))

  (if (and (= new_pre cur_pre) (= new_suf cur_suf))
    (progn (princ "\nИзменений нет.") (exit)))

  ;; Сохранить в XDATA
  (DIMFIX_XDATA_SAVE dim_ent new_pre new_suf)

  ;; Повесить реактор
  (DIMFIX_ATTACH_REACTOR dim_ent)

  ;; Обновить отображение немедленно
  (DIMFIX_UPDATE_TEXT dim_ent new_pre new_suf)
  (entupd dim_ent)

  (princ (strcat "\nГотово! \"" new_pre "<>" new_suf "\""))
  (princ))

;;; ============================================================
;;; КОМАНДА: CLEARDIMFIX — снять преф/суфф с размера
;;; ============================================================

(defun c:CLEARDIMFIX ( / result dim_ent)

  (setq result (DIMFIX_GET_DIM_FROM_CLICK))
  (if (null result) (exit))
  (setq dim_ent (car result))

  ;; Снять реактор
  (DIMFIX_DETACH_REACTOR dim_ent)

  ;; Удалить XDATA
  (DIMFIX_XDATA_CLEAR dim_ent)

  ;; Вернуть стандартный текст "<>"
  (DIMFIX_UPDATE_TEXT dim_ent "" "")
  (entupd dim_ent)

  (princ "\nПреф/суфф сняты, размер сброшен к стандартному виду.")
  (princ))

;;; ============================================================
;;; Восстановить при загрузке (если файл уже открыт)
;;; ============================================================
(if (and (boundp '*DIMFIX_INSTALLED*)
         (/= (getvar "DWGNAME") ""))
  (DIMFIX_RESTORE))

(princ "\nDimFix загружен. Команды: SETDIMFIX / CLEARDIMFIX")
(princ)
;;; EOF