---

;; ============================================================
;; NVK_DOT_ATTR_V3.LSP
;; Точка-блок + атрибуты X/Y/Z
;; Сначала создаётся и вставляется блок,
;; потом значения атрибутов заполняются отдельно.
;; Порядок атрибутов в блоке: X, Y, Z.
;; Команда: NVKDOTA3
;; Кодировка: ANSI (CP1251)
;; ============================================================
(vl-load-com)

(setq NVK-BLOCK-NAME "NVK_DOT_ATTR_V3")
(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:fmt-z (v) (strcat "Z= " (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:add-att (blk pt tag prompt def / a)
  (setq a (vla-AddAttribute blk NVK-TXT-HEIGHT acAttributeModePreset
            prompt (nvk:3d pt) tag def))
  (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)
  a)

(defun nvk:make-block-def (/ blk c r y0)
  (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)

      ;; Порядок атрибутов в свойствах блока: X, потом Y, потом Z
      ;; Расположение над точкой: сверху X, ниже Y, ниже Z
      (nvk:add-att blk (list 0.0 (+ y0 (* 2.8 NVK-TXT-HEIGHT)) 0.0) "X_COORD" "X координата" "X= +0,00")
      (nvk:add-att blk (list 0.0 (+ y0 (* 1.4 NVK-TXT-HEIGHT)) 0.0) "Y_COORD" "Y координата" "Y= +0,00")
      (nvk:add-att blk (list 0.0 y0 0.0)                               "Z_COORD" "Z координата" "Z= +0,00")
    ))
  T)

(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 nvk:set-attr-text-dxf (attname value / ed)
  (if (and attname value)
    (progn
      (setq ed (entget attname))
      (if (assoc 1 ed)
        (entmod (subst (cons 1 value) (assoc 1 ed) ed))
        (entmod (append ed (list (cons 1 value)))))
      (entupd attname))))

(defun nvk:fill-insert-atts (ins xstr ystr zstr / e ed tag)
  (setq e (entnext ins))
  (while e
    (setq ed (entget e))
    (cond
      ((= "ATTRIB" (cdr (assoc 0 ed)))
       (setq tag (strcase (cdr (assoc 2 ed))))
       (cond
         ((= tag "X_COORD") (nvk:set-attr-text-dxf e xstr))
         ((= tag "Y_COORD") (nvk:set-attr-text-dxf e ystr))
         ((= tag "Z_COORD") (nvk:set-attr-text-dxf e zstr)))
       (setq e (entnext e)))
      ((= "SEQEND" (cdr (assoc 0 ed)))
       (setq e nil))
      (T
       (setq e (entnext e)))))
  (entupd ins))

(defun c:NVKDOTA3 (/ *error* olde oldlay p pwcs xw yw zw xstr ystr zstr en)
  (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)
            zw   (caddr pwcs)
            xstr (nvk:fmt-x xw)
            ystr (nvk:fmt-y yw)
            zstr (nvk:fmt-z zw))

      ;; Потом вставляем готовый блок
      (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
          (nvk:fix-block-ref en)
          (nvk:fill-insert-atts en xstr ystr zstr)
          (princ "\n[НВК] Блок вставлен. Атрибуты X/Y/Z заполнены после вставки."))
        (princ "\n[НВК] Не удалось получить ссылку блока после вставки."))
    ))
  (setvar 'CLAYER oldlay)
  (setvar 'CMDECHO olde)
  (princ))

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