;; ============================================================
;; NVK_DOT_ZERO.LSP
;; Минимальный тест: клик -> блок с кружком ровно в точку клика,
;; затем принудительно Rotation = 0
;; Кодировка: ANSI (CP1251)
;; Команда: NVKDOT0
;; ============================================================
(vl-load-com)
(setq NVK-BLOCK-NAME "NVK_DOT_ZERO")
(setq NVK-RADIUS 0.10)
(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:block-exists-p (name)
(not (vl-catch-all-error-p
(vl-catch-all-apply 'vla-Item (list (nvk:blks) name)))))
(defun nvk:make-dot-block (/ blk c)
(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-RADIUS))
(vla-put-Layer c "0")
)
)
T
)
(defun c:NVKDOT0 (/ *error* olde p br)
(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:make-dot-block)
(setq p (getpoint "\nУкажите точку: "))
(if p
(progn
;; p используем как есть: это точка в текущей ПСК
(setq br (vl-catch-all-apply
'vla-InsertBlock
(list (nvk:ms) (nvk:3d p) NVK-BLOCK-NAME 1.0 1.0 1.0 0.0)))
(if (not (vl-catch-all-error-p br))
(progn
(vla-put-Rotation br 0.0)
(princ "\n[НВК] Блок вставлен. Rotation принудительно = 0.")
)
(princ "\n[НВК] Блок не вставлен."))
)
)
(setvar 'CMDECHO olde)
(princ)
)
(princ "\nКоманда: NVKDOT0")
(princ)