---

;;; ============================================================
;;; DIMFIX.LSP v7
;;; XDATA хранится на INSERT (вхождении блока) — не на DIMENSION
;;; Формат XDATA на INSERT:
;;;   (1000 . "DIMFIX")         ; маркер начала блока данных
;;;   (1000 . "handle_размера") ; handle объекта DIMENSION
;;;   (1000 . "префикс")
;;;   (1000 . "суффикс")
;;;   ... повторяется для каждого размера в блоке
;;; ============================================================

(vl-load-com)

(setq *DIMFIX_APP* "DIMFIX_APP")
(if (null *DIMFIX_REACTORS*) (setq *DIMFIX_REACTORS* '()))

;;; ============================================================
;;; БЛОК 1: XDATA на INSERT
;;; ============================================================

(defun DIMFIX_XDATA_REGISTER ()
  (if (null (tblsearch "APPID" *DIMFIX_APP*))
    (entmake (list '(0 . "APPID") (cons 2 *DIMFIX_APP*)))))

;;; Прочитать все записи из XDATA вхождения блока
;;; Возвращает список: (("handle" "преф" "суфф") ...)
(defun DIMFIX_READ_ALL (ins_ent / dxf xdata app_data result
                                  i item h p s)
  (setq dxf   (entget ins_ent (list *DIMFIX_APP*)))
  (setq xdata (assoc -3 dxf))
  (setq result '())
  (if xdata
    (progn
      (setq app_data (cdr (assoc *DIMFIX_APP* (cdr xdata))))
      ;; Пропустить маркер "DIMFIX" и читать тройки
      (setq i 0)
      (while (< i (length app_data))
        (setq item (nth i app_data))
        (if (and (= (car item) 1000)
                 (= (cdr item) "DIMFIX"))
          (progn
            ;; Следующие три: handle, префикс, суффикс
            (if (< (+ i 3) (length app_data))
              (progn
                (setq h (cdr (nth (+ i 1) app_data)))
                (setq p (cdr (nth (+ i 2) app_data)))
                (setq s (cdr (nth (+ i 3) app_data)))
                (setq result (append result (list (list h p s))))
                (setq i (+ i 4)))
              (setq i (1+ i))))
          (setq i (1+ i))))))
  result)

;;; Сохранить запись для конкретного handle в XDATA вхождения
(defun DIMFIX_WRITE_ONE (ins_ent dim_handle pre suf
                         / dxf records new_records found
                           xdata_list rec)
  (DIMFIX_XDATA_REGISTER)
  ;; Прочитать существующие записи
  (setq records (DIMFIX_READ_ALL ins_ent))
  ;; Обновить или добавить запись для этого handle
  (setq found nil)
  (setq new_records
    (mapcar '(lambda (r)
               (if (= (car r) dim_handle)
                 (progn (setq found T) (list dim_handle pre suf))
                 r))
            records))
  (if (null found)
    (setq new_records (append new_records (list (list dim_handle pre suf)))))
  ;; Собрать XDATA список заново
  (setq xdata_list (list *DIMFIX_APP*))
  (foreach rec new_records
    (setq xdata_list
      (append xdata_list
              (list (cons 1000 "DIMFIX")
                    (cons 1000 (nth 0 rec))
                    (cons 1000 (nth 1 rec))
                    (cons 1000 (nth 2 rec))))))
  ;; Записать на INSERT
  (setq dxf (entget ins_ent (list *DIMFIX_APP*)))
  (setq dxf (vl-remove-if '(lambda (x) (= (car x) -3)) dxf))
  (setq dxf (append dxf (list (cons -3 (list xdata_list)))))
  (entmod dxf))

;;; Удалить запись для конкретного handle
(defun DIMFIX_DELETE_ONE (ins_ent dim_handle / dxf records new_records xdata_list rec)
  (setq records (DIMFIX_READ_ALL ins_ent))
  (setq new_records
    (vl-remove-if '(lambda (r) (= (car r) dim_handle)) records))
  (setq dxf (entget ins_ent (list *DIMFIX_APP*)))
  (setq dxf (vl-remove-if '(lambda (x) (= (car x) -3)) dxf))
  (if new_records
    (progn
      (setq xdata_list (list *DIMFIX_APP*))
      (foreach rec new_records
        (setq xdata_list
          (append xdata_list
                  (list (cons 1000 "DIMFIX")
                        (cons 1000 (nth 0 rec))
                        (cons 1000 (nth 1 rec))
                        (cons 1000 (nth 2 rec))))))
      (setq dxf (append dxf (list (cons -3 (list xdata_list)))))))
  (entmod dxf))

;;; Прочитать преф/суфф для конкретного handle из INSERT
(defun DIMFIX_READ_ONE (ins_ent dim_handle / records rec)
  (setq records (DIMFIX_READ_ALL ins_ent))
  (setq rec (assoc dim_handle records))
  (if rec
    (list (cadr rec) (caddr rec))
    nil))

;;; ============================================================
;;; БЛОК 2: ОБНОВЛЕНИЕ ТЕКСТА в *D...
;;; ============================================================

(defun DIMFIX_UPDATE_TEXT (dim_ent pre suf
                           / anon_name anon_def src obj_dxf)
  (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 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 (strcat pre "<>" suf))
                               (assoc 1 obj_dxf)
                               obj_dxf))
                (entupd src)))
            (setq src (entnext src))))))))

;;; ============================================================
;;; БЛОК 3: РЕАКТОРЫ на INSERT
;;; ============================================================

(defun DIMFIX_INS_CHANGED_CB (reactor params / ins_ent records dim_ent)
  ;; Реактор на изменение INSERT — восстанавливаем все преф/суфф
  (setq ins_ent (vlr-owner reactor))
  (if (and ins_ent (not (vlax-erased-p ins_ent)))
    (progn
      (setq records (DIMFIX_READ_ALL ins_ent))
      (foreach rec records
        (setq dim_ent (handent (car rec)))
        (if dim_ent
          (progn
            (DIMFIX_UPDATE_TEXT dim_ent (cadr rec) (caddr rec))
            (entupd dim_ent)))))))

(defun DIMFIX_ATTACH_REACTOR (ins_ent / handle reactor)
  (setq handle (cdr (assoc 5 (entget ins_ent))))
  (if (null (assoc handle *DIMFIX_REACTORS*))
    (progn
      (setq reactor
        (vlr-object-reactor
          (list ins_ent)
          *DIMFIX_APP*
          '((:vlr-modified . DIMFIX_INS_CHANGED_CB))))
      (setq *DIMFIX_REACTORS*
            (append *DIMFIX_REACTORS*
                    (list (cons handle reactor)))))))

(defun DIMFIX_DETACH_REACTOR (ins_ent / handle entry reactor)
  (setq handle (cdr (assoc 5 (entget ins_ent))))
  (setq entry  (assoc handle *DIMFIX_REACTORS*))
  (if entry
    (progn
      (setq reactor (cdr entry))
      (vlr-remove reactor)
      (setq *DIMFIX_REACTORS*
            (vl-remove entry *DIMFIX_REACTORS*)))))

;;; ============================================================
;;; БЛОК 4: ВОССТАНОВЛЕНИЕ — ищем INSERT с нашими XDATA
;;; ============================================================

(defun DIMFIX_RESTORE ( / ent dxf records dim_ent)
  (setq *DIMFIX_REACTORS* '())
  (setq ent (entnext))
  (while ent
    (setq dxf (entget ent (list *DIMFIX_APP*)))
    (if (and (= (cdr (assoc 0 dxf)) "INSERT")
             (assoc -3 dxf))
      (progn
        (setq records (DIMFIX_READ_ALL ent))
        (if records
          (progn
            (DIMFIX_ATTACH_REACTOR ent)
            (foreach rec records
              (setq dim_ent (handent (car rec)))
              (if dim_ent
                (progn
                  (DIMFIX_UPDATE_TEXT dim_ent (cadr rec) (caddr rec))
                  (entupd dim_ent))))))))
    (setq ent (entnext ent)))
  (princ))

(defun DIMFIX_ON_OPEN (reactor params)
  (DIMFIX_RESTORE))

(defun DIMFIX_ON_COMMAND_END (reactor params)
  (if (and params (listp params) (car params) (stringp (car params)))
    (if (member (strcase (car params))
                '("REGEN" "REGENALL" "REGENVISIBLE"))
      (DIMFIX_RESTORE))))

(vlr-dwg-reactor    nil '((:vlr-endDwgOpen   . DIMFIX_ON_OPEN)))
(vlr-editor-reactor nil '((:vlr-commandEnded . DIMFIX_ON_COMMAND_END)))

;;; ============================================================
;;; БЛОК 5: ПОИСК БЛИЖАЙШЕГО РАЗМЕРА В БЛОКЕ
;;; ============================================================

(defun DIMFIX_DIST2D (p1 p2)
  (sqrt (+ (expt (- (car p1)  (car p2))  2)
           (expt (- (cadr p1) (cadr p2)) 2))))

(defun DIMFIX_DIM_TEXTPOS (dim_ent / dxf anon_name anon_def src obj_dxf pt)
  (setq dxf       (entget dim_ent))
  (setq anon_name (cdr (assoc 2 dxf)))
  (setq pt nil)
  (if (and anon_name (= (substr anon_name 1 2) "*D"))
    (progn
      (setq anon_def (tblobjname "BLOCK" anon_name))
      (if anon_def
        (progn
          (setq src (entnext anon_def))
          (while (and src
                      (/= (cdr (assoc 0 (entget src))) "ENDBLK"))
            (setq obj_dxf (entget src))
            (if (and (null pt)
                     (member (cdr (assoc 0 obj_dxf)) '("TEXT" "MTEXT")))
              (setq pt (cdr (assoc 10 obj_dxf))))
            (setq src (entnext src)))))))
  (if (null pt)
    (setq pt (cdr (assoc 11 (entget dim_ent)))))
  pt)

(defun DIMFIX_FIND_NEAREST_DIM (blk_name click_pt
                                / blk_def src obj_dxf
                                  best_ent best_dist cur_pt cur_dist)
  (setq blk_def (tblobjname "BLOCK" blk_name))
  (if (null blk_def)
    (progn
      (princ (strcat "\nОшибка: определение блока \""
                     blk_name "\" не найдено."))
      nil)
    (progn
      (setq best_ent nil  best_dist nil)
      (setq src (entnext blk_def))
      (while (and src
                  (/= (cdr (assoc 0 (entget src))) "ENDBLK"))
        (setq obj_dxf (entget src))
        (if (= (cdr (assoc 0 obj_dxf)) "DIMENSION")
          (progn
            (setq cur_pt (DIMFIX_DIM_TEXTPOS src))
            (if cur_pt
              (progn
                (setq cur_dist (DIMFIX_DIST2D click_pt cur_pt))
                (if (or (null best_dist) (< cur_dist best_dist))
                  (progn
                    (setq best_ent  src)
                    (setq best_dist cur_dist)))))))
        (setq src (entnext src)))
      (if (null best_ent)
        (progn
          (princ (strcat "\nОшибка: в блоке \""
                         blk_name "\" не найден ни один DIMENSION."))
          nil)
        best_ent))))

;;; ============================================================
;;; БЛОК 6: ВЫБОР БЛОКА
;;; ============================================================

(defun DIMFIX_GET_DIM_FROM_CLICK ( / sel ins_ent dxf blk_name
                                     click_pt dim_ent)
  (setq sel (entsel "\nКликните на блок с размером: "))
  (if (null sel)
    (progn (princ "\nОтмена.") nil)
    (progn
      (setq ins_ent  (car sel))
      (setq click_pt (cadr sel))
      (setq dxf      (entget ins_ent))
      (if (/= (cdr (assoc 0 dxf)) "INSERT")
        (progn
          (princ (strcat "\nОшибка: выбран объект типа \""
                         (cdr (assoc 0 dxf))
                         "\", нужен блок (INSERT)."))
          nil)
        (progn
          (setq blk_name (cdr (assoc 2 dxf)))
          (setq dim_ent  (DIMFIX_FIND_NEAREST_DIM blk_name click_pt))
          (if (null dim_ent)
            nil
            (progn
              (princ (strcat "\nНайден размер: "
                             (rtos (cdr (assoc 42 (entget dim_ent)))
                                   2 2)))
              (list dim_ent ins_ent))))))))

;;; ============================================================
;;; БЛОК 7: АВТОУСТАНОВКА
;;; ============================================================

(defun DIMFIX_INSTALL ( / lsp_path support_dir acaddoc_path
                          f line found load_line lsp_path_fwd file_dir)
  (setq lsp_path (findfile "dimfix.lsp"))
  (if (null lsp_path)
    (progn
      (setq lsp_path (getfiled "Укажите dimfix.lsp" "" "lsp" 0))
      (if (null lsp_path)
        (progn (princ "\nУстановка отменена.") (exit)))))
  (setq *DIMFIX_LSP_PATH* lsp_path)
  (setq file_dir    (vl-filename-directory lsp_path))
  (setq support_dir (vl-filename-directory (findfile "acad.pat")))
  (if (null support_dir) (setq support_dir file_dir))
  (setq acaddoc_path (strcat support_dir "acaddoc.lsp"))
  (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 "\nУстановлен в: " acaddoc_path))
      (princ "\nПри следующем запуске AutoCAD загрузится автоматически.")))
  (setq cur_paths (getenv "ACAD"))
  (if (null (vl-string-search
              (strcase file_dir)
              (strcase (if cur_paths cur_paths ""))))
    (setenv "ACAD"
            (strcat (if cur_paths cur_paths "") ";" file_dir)))
  (princ))

(if (null *DIMFIX_INSTALLED*)
  (progn
    (DIMFIX_INSTALL)
    (setq *DIMFIX_INSTALLED* T)))

;;; ============================================================
;;; КОМАНДА: SETDIMFIX
;;; ============================================================

(defun c:SETDIMFIX ( / result dim_ent ins_ent dim_handle
                       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 ins_ent   (cadr result))
  (setq dim_handle (cdr (assoc 5 (entget dim_ent))))

  (setq cur_data (DIMFIX_READ_ONE ins_ent dim_handle))
  (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)
                 "  Преф: \""   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)))

  ;; Сохранить на INSERT (не на DIMENSION!)
  (DIMFIX_WRITE_ONE   ins_ent dim_handle new_pre new_suf)
  (DIMFIX_ATTACH_REACTOR ins_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 ins_ent dim_handle records)
  (setq result (DIMFIX_GET_DIM_FROM_CLICK))
  (if (null result) (exit))
  (setq dim_ent    (car result))
  (setq ins_ent    (cadr result))
  (setq dim_handle (cdr (assoc 5 (entget dim_ent))))

  (DIMFIX_DELETE_ONE  ins_ent dim_handle)
  (DIMFIX_UPDATE_TEXT dim_ent "" "")
  (entupd dim_ent)

  ;; Если записей больше нет — снять реактор
  (setq records (DIMFIX_READ_ALL ins_ent))
  (if (null records)
    (DIMFIX_DETACH_REACTOR ins_ent))

  (princ "\nПреф/суфф сброшены.")
  (princ))

;;; Восстановить при загрузке если чертёж уже открыт
(if (/= (getvar "DWGNAME") "") (DIMFIX_RESTORE))

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