---

;; ============================================================
;; NVK_COORDS.LSP  v4.0
;; Стабильный этап: один блок = маркер + видимые строки X/Y + скрытые X/Y
;; Кодировка: ANSI (CP1251)
;; Команда: NVKCOORD
;; ============================================================
(vl-load-com)

(setq NVK-LAYER      "НВК_Координаты точек")
(setq NVK-BLOCK-NAME "НВК_Координаты")
(setq NVK-PT-DIAM    0.5)
(setq NVK-TXT-HEIGHT 1.0)
(setq NVK-TXT-OFFSET 0.8)
(setq NVK-TEXT-STYLE "Arial")

(defun nvk:doc  () (vla-get-ActiveDocument (vlax-get-acad-object)))
(defun nvk:ms   () (vla-get-ModelSpace (nvk:doc)))
(defun nvk:blks () (vla-get-Blocks (nvk:doc)))
(defun nvk:3d (p) (vlax-3d-point (list (car p) (cadr p) (if (caddr p) (caddr p) 0.0))))
(defun nvk:wcs (p) (trans p 1 0))

(defun nvk:rtos2 (v / s)
  (setq s (vl-string-subst "," "." (rtos (abs v) 2 2)))
  (strcat (if (minusp v) "-" "+") s))
(defun nvk:fmt-x (v) (strcat "X= " (nvk:rtos2 v)))
(defun nvk:fmt-y (v) (strcat "Y= " (nvk:rtos2 v)))

(defun nvk:block-exists-p (name)
  (not (vl-catch-all-error-p
         (vl-catch-all-apply 'vla-Item (list (nvk:blks) name)))))

(defun nvk:ensure-layer (/ lay)
  (if (tblsearch "LAYER" NVK-LAYER)
    (setq lay (vla-Item (vla-get-Layers (nvk:doc)) NVK-LAYER))
    (setq lay (vla-Add  (vla-get-Layers (nvk:doc)) NVK-LAYER)))
  (if (= (vla-get-Color lay) 7)
    (vla-put-Color lay 1))
  lay)

(defun nvk:ensure-style (/ sty)
  (if (tblsearch "STYLE" NVK-TEXT-STYLE)
    (setq sty (vla-Item (vla-get-TextStyles (nvk:doc)) NVK-TEXT-STYLE))
    (setq sty (vla-Add  (vla-get-TextStyles (nvk:doc)) NVK-TEXT-STYLE)))
  (vl-catch-all-apply 'vla-put-FontFile (list sty "arial.ttf"))
  sty)

(defun nvk:add-solid-fan (owner r / da rm i a1 a2)
  (setq da (/ (* 2.0 pi) 8.0)
        rm (* r 0.98)
        i  0)
  (repeat 8
    (setq a1 (* i da)
          a2 (* (1+ i) da)
          i  (1+ i))
    (vla-AddSolid owner
      (nvk:3d (list (+ (* rm (cos a1))) (+ (* rm (sin a1))) 0.0))
      (nvk:3d (list (+ (* rm (cos a2))) (+ (* rm (sin a2))) 0.0))
      (nvk:3d '(0.0 0.0 0.0))
      (nvk:3d '(0.0 0.0 0.0)))))

(defun nvk:make-block-def (/ blk c a)
  (if (not (nvk:block-exists-p NVK-BLOCK-NAME))
    (progn
      (setq blk (vla-Add (nvk:blks) (nvk:3d '(0.0 0.0 0.0)) NVK-BLOCK-NAME))

      ;; Маркер внутри блока
      (setq c (vla-AddCircle blk (nvk:3d '(0.0 0.0 0.0)) (/ NVK-PT-DIAM 2.0)))
      (vla-put-Layer c NVK-LAYER)
      (vla-put-Color c acByLayer)
      (nvk:add-solid-fan blk (/ NVK-PT-DIAM 2.0))

      ;; Видимые строки
      (setq a (vla-AddAttribute blk NVK-TXT-HEIGHT acAttributeModePreset "Координата X" (nvk:3d (list 0.0 (+ (/ NVK-PT-DIAM 2.0) NVK-TXT-OFFSET) 0.0)) "X_LINE" "X= +0,00"))
      (vla-put-StyleName a NVK-TEXT-STYLE)
      (vla-put-Layer a NVK-LAYER)
      (vla-put-Color a acByLayer)
      (vla-put-Rotation a 0.0)

      (setq a (vla-AddAttribute blk NVK-TXT-HEIGHT acAttributeModePreset "Координата Y" (nvk:3d (list 0.0 (+ (/ NVK-PT-DIAM 2.0) NVK-TXT-OFFSET (- (* 1.4 NVK-TXT-HEIGHT))) 0.0)) "Y_LINE" "Y= +0,00"))
      (vla-put-StyleName a NVK-TEXT-STYLE)
      (vla-put-Layer a NVK-LAYER)
      (vla-put-Color a acByLayer)
      (vla-put-Rotation a 0.0)

      ;; Скрытые служебные атрибуты
      (setq a (vla-AddAttribute blk NVK-TXT-HEIGHT acAttributeModeInvisible "X скрытый" (nvk:3d '(0.0 0.0 0.0)) "X_COORD" ""))
      (vla-put-StyleName a NVK-TEXT-STYLE)
      (vla-put-Layer a NVK-LAYER)
      (setq a (vla-AddAttribute blk NVK-TXT-HEIGHT acAttributeModeInvisible "Y скрытый" (nvk:3d '(0.0 0.0 0.0)) "Y_COORD" ""))
      (vla-put-StyleName a NVK-TEXT-STYLE)
      (vla-put-Layer a NVK-LAYER)
    ))
  T)

(defun nvk:insert-block (pwcs / br)
  (setq br (vl-catch-all-apply 'vla-InsertBlock (list (nvk:ms) (nvk:3d pwcs) NVK-BLOCK-NAME 1.0 1.0 1.0 0.0)))
  (if (vl-catch-all-error-p br)
    nil
    (progn (vla-put-Layer br NVK-LAYER) br)))

(defun nvk:set-attrs (br pairs / tag)
  (if (and br (= :vlax-true (vla-get-HasAttributes br)))
    (foreach a (vlax-safearray->list (vlax-variant-value (vla-GetAttributes br)))
      (setq tag (strcase (vla-get-TagString a)))
      (foreach p pairs
        (if (= tag (strcase (car p)))
          (progn
            (vla-put-TextString a (cadr p))
            ;; Принудительно держим текст горизонтально
            (vl-catch-all-apply 'vla-put-Rotation (list a 0.0))))))))

(defun c:NVKCOORD (/ *error* olde p pwcs br xw yw)
  (defun *error* (msg)
    (if olde (setvar 'CMDECHO olde))
    (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nОшибка: " msg)))
    (princ))
  (setq olde (getvar 'CMDECHO))
  (setvar 'CMDECHO 0)
  (nvk:ensure-layer)
  (nvk:ensure-style)
  (nvk:make-block-def)
  (setq p (getpoint "\nУкажите базовую точку: "))
  (if p
    (progn
      (setq pwcs (nvk:wcs p)
            xw   (car pwcs)
            yw   (cadr pwcs))
      (setq br (nvk:insert-block pwcs))
      (if br
        (progn
          (nvk:set-attrs br
            (list
              (list "X_LINE"  (nvk:fmt-x yw))
              (list "Y_LINE"  (nvk:fmt-y xw))
              (list "X_COORD" (nvk:fmt-x yw))
              (list "Y_COORD" (nvk:fmt-y xw))))
          (princ "\n[НВК] Блок создан."))
        (princ "\n[НВК] Блок не создан."))))
  (setvar 'CMDECHO olde)
  (princ))

(princ "\nНВК_Координаты v4.0 загружена. Команда: NVKCOORD")
(princ)