---

;; ============================================================
;; NVK_COORDS.LSP  v3.9
;; ЭТАП 1: круг + служебный блок + отдельный текстовый блок
;; Кодировка: ANSI (CP1251)
;; Команда: NVKCOORD
;; ============================================================
(vl-load-com)

(setq NVK-LAYER       "НВК_Координаты точек")
(setq NVK-DATA-BLOCK  "НВК_Коорд_Данные")
(setq NVK-LABEL-BLOCK "НВК_Коорд_Текст")
(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:ucsx-ang (/ v)
  (setq v (getvar "UCSXDIR"))
  (angle '(0.0 0.0 0.0) v)
)

(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: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:block-exists-p (name)
  (not (vl-catch-all-error-p
         (vl-catch-all-apply 'vla-Item (list (nvk:blks) name))))
)

(defun nvk:make-data-block (/ blk)
  (if (not (nvk:block-exists-p NVK-DATA-BLOCK))
    (progn
      (setq blk (vla-Add (nvk:blks) (nvk:3d '(0.0 0.0 0.0)) NVK-DATA-BLOCK))
      (vla-AddAttribute blk NVK-TXT-HEIGHT acAttributeModeInvisible "X_COORD" (nvk:3d '(0.0 0.0 0.0)) "X_COORD" "")
      (vla-AddAttribute blk NVK-TXT-HEIGHT acAttributeModeInvisible "Y_COORD" (nvk:3d '(0.0 0.0 0.0)) "Y_COORD" "")
    )
  )
  T
)

(defun nvk:make-label-block (/ blk a1 a2)
  (if (not (nvk:block-exists-p NVK-LABEL-BLOCK))
    (progn
      (setq blk (vla-Add (nvk:blks) (nvk:3d '(0.0 0.0 0.0)) NVK-LABEL-BLOCK))
      (setq a1 (vla-AddAttribute blk NVK-TXT-HEIGHT acAttributeModePreset "X" (nvk:3d '(0.0 0.0 0.0)) "X_LINE" "X= +0,00"))
      (setq a2 (vla-AddAttribute blk NVK-TXT-HEIGHT acAttributeModePreset "Y" (nvk:3d (list 0.0 (* -1.4 NVK-TXT-HEIGHT) 0.0)) "Y_LINE" "Y= +0,00"))
      (vla-put-StyleName a1 NVK-TEXT-STYLE)
      (vla-put-StyleName a2 NVK-TEXT-STYLE)
      (vla-put-Layer a1 NVK-LAYER)
      (vla-put-Layer a2 NVK-LAYER)
      (vla-put-Rotation a1 0.0)
      (vla-put-Rotation a2 0.0)
    )
  )
  T
)

(defun nvk:set-attrs (br pairs / arr tag val)
  (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)))
          (vla-put-TextString a (cadr p))
        )
      )
    )
  )
)

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

(defun nvk:draw-marker (p / cx cy r da rm i a1 a2)
  (setq cx (car p)
        cy (cadr p)
        r  (/ NVK-PT-DIAM 2.0)
        da (/ (* 2.0 pi) 8.0)
        rm (* r 0.98)
        i  0)
  (entmakex (list '(0 . "CIRCLE")
                  (cons 8 NVK-LAYER)
                  '(62 . 256)
                  '(6 . "BYLAYER")
                  (cons 10 (list cx cy 0.0))
                  (cons 40 r)))
  (repeat 8
    (setq a1 (* i da)
          a2 (* (1+ i) da)
          i  (1+ i))
    (entmakex (list '(0 . "SOLID")
                    (cons 8 NVK-LAYER)
                    '(62 . 256)
                    '(6 . "BYLAYER")
                    (cons 10 (list (+ cx (* rm (cos a1))) (+ cy (* rm (sin a1))) 0.0))
                    (cons 11 (list (+ cx (* rm (cos a2))) (+ cy (* rm (sin a2))) 0.0))
                    (cons 12 (list cx cy 0.0))
                    (cons 13 (list cx cy 0.0)))))
  T
)

(defun c:NVKCOORD (/ *error* olde p0 pwcs xw yw rot dataBr textBr textPt)
  (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-data-block)
  (nvk:make-label-block)
  (setq p0 (getpoint "\nУкажите базовую точку: "))
  (if p0
    (progn
      (setq pwcs   (nvk:wcs p0)
            xw     (car pwcs)
            yw     (cadr pwcs)
            rot    (- (nvk:ucsx-ang))
            textPt (list (car pwcs) (+ (cadr pwcs) (/ NVK-PT-DIAM 2.0) NVK-TXT-OFFSET) 0.0))
      (nvk:draw-marker pwcs)
      (setq dataBr (nvk:insert-block NVK-DATA-BLOCK pwcs 0.0))
      (setq textBr (nvk:insert-block NVK-LABEL-BLOCK textPt rot))
      (if dataBr
        (progn
          (nvk:set-attrs dataBr (list (list "X_COORD" (nvk:fmt-x yw))
                                      (list "Y_COORD" (nvk:fmt-y xw))))
          (princ "\n[НВК] Блок данных создан.")
        )
        (princ "\n[НВК] Блок данных не создан.")
      )
      (if textBr
        (progn
          (nvk:set-attrs textBr (list (list "X_LINE" (nvk:fmt-x yw))
                                      (list "Y_LINE" (nvk:fmt-y xw))))
          (princ "\n[НВК] Текстовый блок создан.")
        )
        (princ "\n[НВК] Текстовый блок не создан.")
      )
    )
  )
  (setvar 'CMDECHO olde)
  (princ)
)

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