---

;; ============================================================
;; NVK_DOT_ATTR_V1.LSP
;; Точка-блок + 2 однострочных атрибута над точкой
;; Вставка в текущей ПСК, запись координат в МСК
;; Команда: NVKDOTA1
;; Кодировка: ANSI (CP1251)
;; ============================================================
(vl-load-com)

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

(defun nvk:doc  () (vla-get-ActiveDocument (vlax-get-acad-object)))
(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 (/ lays lay)
  (setq lays (vla-get-Layers (nvk:doc)))
  (if (tblsearch "LAYER" NVK-LAYER)
    (setq lay (vla-Item lays NVK-LAYER))
    (setq lay (vla-Add lays NVK-LAYER)))
  (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:set-insbase-zero ()
  (setvar 'INSBASE '(0.0 0.0 0.0)))

(defun nvk:add-solid-fan (blk r / da rm i a1 a2 s)
  (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))
    (setq s
      (vla-AddSolid blk
        (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))))
    (vla-put-Layer s "0")
    (vla-put-Color s acByLayer)
    (vla-put-Linetype s "ByLayer")))

(defun nvk:make-block-def (/ blk c r y0 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))
      (vl-catch-all-apply 'vla-put-Units (list blk acUnitless))
      (setq r  (/ NVK-PT-DIAM 2.0)
            y0 (+ r NVK-TXT-OFFSET))

      ;; Маркер точки
      (setq c (vla-AddCircle blk (nvk:3d '(0.0 0.0 0.0)) r))
      (vla-put-Layer c "0")
      (vla-put-Color c acByLayer)
      (vla-put-Linetype c "ByLayer")
      (nvk:add-solid-fan blk r)

      ;; Два однострочных атрибута над точкой, по слою через Layer 0 + ByLayer
      ;; Нижняя строка: Y
      (setq a (vla-AddAttribute blk NVK-TXT-HEIGHT acAttributeModePreset
                "Y координата" (nvk:3d (list 0.0 y0 0.0)) "Y_COORD" "Y= +0,00"))
      (vla-put-Layer a "0")
      (vla-put-Color a acByLayer)
      (vla-put-Linetype a "ByLayer")
      (vla-put-StyleName a NVK-TEXT-STYLE)
      (vla-put-Rotation a 0.0)

      ;; Верхняя строка: X
      (setq a (vla-AddAttribute blk NVK-TXT-HEIGHT acAttributeModePreset
                "X координата" (nvk:3d (list 0.0 (+ y0 (* 1.4 NVK-TXT-HEIGHT)) 0.0)) "X_COORD" "X= +0,00"))
      (vla-put-Layer a "0")
      (vla-put-Color a acByLayer)
      (vla-put-Linetype a "ByLayer")
      (vla-put-StyleName a NVK-TEXT-STYLE)
      (vla-put-Rotation a 0.0)
    ))
  T)

(defun nvk:set-attrs (br xstr ystr)
  (if (and br (= :vlax-true (vla-get-HasAttributes br)))
    (foreach a (vlax-safearray->list (vlax-variant-value (vla-GetAttributes br)))
      (cond
        ((= (strcase (vla-get-TagString a)) "X_COORD")
         (vla-put-TextString a xstr)
         (vl-catch-all-apply 'vla-put-Rotation (list a 0.0)))
        ((= (strcase (vla-get-TagString a)) "Y_COORD")
         (vla-put-TextString a ystr)
         (vl-catch-all-apply 'vla-put-Rotation (list a 0.0)))))))

(defun nvk:fix-block-ref (en / obj)
  (if en
    (progn
      (setq obj (vlax-ename->vla-object en))
      (if obj
        (progn
          (vla-put-Layer obj NVK-LAYER)
          (vla-put-XScaleFactor obj 1.0)
          (vla-put-YScaleFactor obj 1.0)
          (vla-put-ZScaleFactor obj 1.0)
          (vla-put-Rotation obj 0.0)
          (vl-catch-all-apply 'vla-Update (list obj))
          obj)))))

(defun c:NVKDOTA1 (/ *error* olde oldlay p pwcs xw yw xstr ystr en br)
  (defun *error* (msg)
    (if oldlay (setvar 'CLAYER oldlay))
    (if olde   (setvar 'CMDECHO olde))
    (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nОшибка: " msg)))
    (princ))
  (setq olde   (getvar 'CMDECHO)
        oldlay (getvar 'CLAYER))
  (setvar 'CMDECHO 0)
  (nvk:ensure-layer)
  (nvk:ensure-style)
  (nvk:set-insbase-zero)
  (nvk:make-block-def)
  (setq p (getpoint "\nУкажите точку: "))
  (if p
    (progn
      ;; Координаты для подписи берём в МСК, как в главной логике
      (setq pwcs (nvk:wcs p)
            xw   (car pwcs)
            yw   (cadr pwcs)
            xstr (nvk:fmt-x yw)
            ystr (nvk:fmt-y xw))

      ;; Вставка строго в текущей ПСК, как уже проверено
      (setvar 'CLAYER NVK-LAYER)
      (command "_.-INSERT" NVK-BLOCK-NAME p 1 1 1 0)
      (setq en (entlast))
      (if (and en (= "INSERT" (cdr (assoc 0 (entget en)))))
        (progn
          (setq br (nvk:fix-block-ref en))
          (nvk:set-attrs br xstr ystr)
          (princ "\n[НВК] Блок вставлен, X/Y записаны в атрибуты по МСК."))
        (princ "\n[НВК] Не удалось получить ссылку блока после вставки."))
    ))
  (setvar 'CLAYER oldlay)
  (setvar 'CMDECHO olde)
  (princ))

(princ "\nКоманда: NVKDOTA1")
(princ)