---

;;; ============================================================
;;; DIMFIX.LSP v4
;;; Редактирование префикса/суффикса размеров внутри блоков
;;; ============================================================

(vl-load-com)

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

;;; ============================================================
;;; БЛОК 1: XDATA
;;; ============================================================

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

(defun DIMFIX_XDATA_SAVE (dim_ent pre suf / dxf)
  (DIMFIX_XDATA_REGISTER)
  (setq dxf (entget dim_ent (list *DIMFIX_APP*)))
  (setq dxf (vl-remove-if '(lambda (x) (= (car x) -3)) dxf))
  (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)
  (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))
              (cdr (cadr app_data)))
        nil))
    nil))

(defun DIMFIX_XDATA_CLEAR (dim_ent / dxf)
  (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)
  (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: РЕАКТОРЫ
;;; ============================================================

(defun DIMFIX_CHANGED_CB (reactor params / dim_ent data)
  (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
          (DIMFIX_UPDATE_TEXT dim_ent (car data) (cadr data))
          (entupd dim_ent))))))

(defun DIMFIX_ATTACH_REACTOR (dim_ent / handle reactor)
  (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)
      (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: ВОССТАНОВЛЕНИЕ
;;; Перебор всех DIMENSION через entnext — без ssget фильтра -3
;;; ============================================================

(defun DIMFIX_RESTORE ( / ent dxf data)
  (setq *DIMFIX_REACTORS* '())
  ;; Перебрать все объекты чертежа
  (setq ent (entnext))
  (while ent
    (setq dxf (entget ent))
    (if (= (cdr (assoc 0 dxf)) "DIMENSION")
      (progn
        (setq data (DIMFIX_XDATA_LOAD ent))
        (if data
          (progn
            (DIMFIX_ATTACH_REACTOR ent)
            (DIMFIX_UPDATE_TEXT ent (car data) (cadr data))
            (entupd 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: РАЗБОР КЛИКА
;;; nentsel возвращает: (объект матрица путь)
;;; объект = car, матрица = cadr, путь = caddr
;;; НО: если объект вложен глубже — путь может быть в cadddr
;;; Проверяем оба варианта
;;; ============================================================

(defun DIMFIX_PARSE_PATH (sel / raw3 raw4 path)
  ;; Определить где находится путь вхождений
  ;; nentsel: (picked_ent transform_matrix (INSERT... INSERT...))
  ;; Путь — это список из INSERT-объектов
  (setq raw3 (caddr  sel))
  (setq raw4 (cadddr sel))
  (cond
    ;; caddr — список entity-имён (путь)
    ((and raw3 (listp raw3) (car raw3) (not (numberp (car raw3))))
     raw3)
    ;; cadddr — список entity-имён (путь, старый формат)
    ((and raw4 (listp raw4) (car raw4) (not (numberp (car raw4))))
     raw4)
    ;; caddr — список матрицы (числа), тогда путь в cadddr
    (T raw4)))

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

      (if (null path)
        (progn
          (princ "\nНе удалось определить вхождение блока.")
          nil)
        (progn
          (setq anon_ins nil  blk_ref nil)

          (foreach ent path
            ;; Убедиться что ent — entity (не число и не список)
            (if (and ent (not (listp ent)) (not (numberp ent)))
              (progn
                (setq edxf  (entget ent))
                (setq ename (cdr (assoc 2 edxf)))
                (cond
                  ((and ename
                        (= (cdr (assoc 0 edxf)) "INSERT")
                        (= (substr ename 1 2) "*D")
                        (null anon_ins))
                   (setq anon_ins ent  anon_name ename))
                  ((and ename
                        (= (cdr (assoc 0 edxf)) "INSERT")
                        (/= (substr ename 1 1) "*")
                        (null blk_ref))
                   (setq blk_ref ent  blk_name ename))))))

          (cond
            ((null anon_ins)
             (princ "\nКликните именно на цифры размера (не на линию)!")
             nil)
            ((null blk_ref)
             (princ "\nРазмер не находится внутри пользовательского блока!")
             nil)
            (T
             (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: АВТОУСТАНОВКА
;;; ============================================================

(defun DIMFIX_FIND_SELF ()
  (findfile "dimfix.lsp"))

(defun DIMFIX_INSTALL ( / lsp_path support_dir acaddoc_path
                          f line found load_line lsp_path_fwd file_dir)
  (setq lsp_path (DIMFIX_FIND_SELF))
  (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 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)
                 "  Преф: \""   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)))
  (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)
  (DIMFIX_XDATA_CLEAR    dim_ent)
  (DIMFIX_UPDATE_TEXT    dim_ent "" "")
  (entupd dim_ent)
  (princ "\nПреф/суфф сброшены.")
  (princ))

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

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