---

;; ============================================================
;; NVK_DOT_ATTR_V4.LSP
;; Решение без атрибутов в определении блока.
;; 1) вставляется пустой блок-точка;
;; 2) затем рядом создаются 3 TEXT в текущей ПСК чертежа;
;; 3) порядок в логике: X, Y, Z.
;; Команда: NVKDOTA4
;; Кодировка: ANSI (CP1251)
;; ============================================================
(vl-load-com)

(setq NVK-BLOCK-NAME "NVK_DOT_TEXT_V4")
(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:ms   () (if (= 1 (getvar 'CVPORT)) (vla-get-PaperSpace (nvk:doc)) (vla-get-ModelSpace (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:vec-ucs->wcs (v) (trans v 1 0 T))

(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:make-block-def (/ blk c r)
  (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))
      (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)
    ))
  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:add-ucs-text (base ucsdy txt / ms ins obj exv)
  ;; base подаётся в текущей ПСК; смещение тоже в текущей ПСК
  ;; в базу БД пишем WCS-координату и extrusion текущей ПСК,
  ;; чтобы текст жил именно в плоскости текущей ПСК
  (setq ms  (nvk:ms)
        ins (nvk:wcs (mapcar '+ base (list 0.0 ucsdy 0.0)))
        obj (vla-AddText ms txt (nvk:3d ins) NVK-TXT-HEIGHT)
        exv (nvk:vec-ucs->wcs '(0.0 0.0 1.0)))
  (vla-put-Layer obj NVK-LAYER)
  (vla-put-StyleName obj NVK-TEXT-STYLE)
  (vla-put-Color obj acByLayer)
  (vla-put-Rotation obj 0.0)
  (vl-catch-all-apply 'vla-put-Normal (list obj (nvk:3d exv)))
  obj)

(defun c:NVKDOTA4 (/ *error* olde oldlay p pwcs xw yw zw xstr ystr zstr en r y0)
  (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)
            r    (/ NVK-PT-DIAM 2.0)
            y0   (+ r NVK-TXT-OFFSET))

      ;; Вставляем только точку-блок
      (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)
          ;; Тексты создаём ОТДЕЛЬНО в текущей ПСК, а не как атрибуты блока
          ;; Порядок: X, Y, Z
          (nvk:add-ucs-text p (+ y0 (* 2.8 NVK-TXT-HEIGHT)) xstr)
          (nvk:add-ucs-text p (+ y0 (* 1.4 NVK-TXT-HEIGHT)) ystr)
          (nvk:add-ucs-text p y0                               zstr)
          (princ "\n[НВК] Точка вставлена. Подписи X/Y/Z созданы отдельными TEXT в текущей ПСК."))
        (princ "\n[НВК] Не удалось получить ссылку блока после вставки."))
    ))
  (setvar 'CLAYER oldlay)
  (setvar 'CMDECHO olde)
  (princ))

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