Загрузка данных


;; ============================================================
;; 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)