;;; ============================================================
;;; XRCOPYVISIBLE.lsp — копирование собственной геометрии XREF
;;;
;;; Команда XRCOPYVISIBLE выбирает ВЕРХНЮЮ внешнюю ссылку в текущем
;;; чертеже и переносит доступные прямые объекты её DWG в текущий файл.
;;; Вложенные XREF не трогает: битые не мешают операции.
;;;
;;; ВАЖНО:
;;; - команда не отсоединяет и не внедряет исходную ссылку;
;;; - текущий DWG должен быть сохранён до запуска;
;;; - после выполнения надо визуально проверить результат и сохранить DWG;
;;; - геометрия, которая была только в любой вложенной XREF, не копируется.
;;; ============================================================

(vl-load-com)

(defun xrcv:tools-dir (/ f)
  (if (setq f (findfile "XRCOPYVISIBLE.lsp"))
    (vl-string-translate "/" "\\" (vl-filename-directory f))
    "G:\\Мой диск\\lisp-code\\SPIS"
  )
)

(defun xrcv:python (/ tools local)
  (setq tools (xrcv:tools-dir))
  (setq local (strcat (vl-string-right-trim "\\/" tools) "\\.venv\\Scripts\\pythonw.exe"))
  (if (findfile local)
    local
    (progn
      (setq local (strcat (vl-string-right-trim "\\/" tools) "\\.venv\\Scripts\\python.exe"))
      (if (findfile local) local "python")
    )
  )
)

(defun xrcv:xref-object-p (obj / name blk)
  (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
       (not (vl-catch-all-error-p
              (setq blk (vl-catch-all-apply 'vla-Item
                         (list (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
                               (vla-get-Name obj))))))
       (= (vla-get-IsXRef blk) :vlax-true)
  )
)

(defun xrcv:pt-value (pt i)
  (rtos (nth i (vlax-safearray->list (vlax-variant-value pt))) 2 10)
)

(defun c:XRCOPYVISIBLE (/ doc pick en obj blk source target ip sx sy sz rot tools script vpython cmd shell res)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq target (vla-get-FullName doc))
  (cond
    ((or (not target) (= target ""))
      (prompt "\nXRCOPYVISIBLE: сначала сохраните текущий DWG (SAVEAS).")
    )
    (T
      (prompt "\nВыберите ВЕРХНЮЮ внешнюю ссылку с планом: ")
      (setq pick (entsel))
      (cond
        ((not pick)
          (prompt "\nXRCOPYVISIBLE: объект не выбран.")
        )
        (T
          (setq en (car pick)
                obj (vlax-ename->vla-object en))
          (cond
            ((not (xrcv:xref-object-p obj))
              (prompt "\nXRCOPYVISIBLE: выбранный объект не является верхней внешней ссылкой.")
            )
            (T
              (setq blk (vla-Item (vla-get-Blocks doc) (vla-get-Name obj)))
              (setq source (vla-get-Path blk))
              (cond
                ((or (not source) (= source "") (not (findfile source)))
                  (prompt "\nXRCOPYVISIBLE: исходный DWG верхней ссылки не найден. Путь не изменён.")
                )
                (T
                  (setq ip (vla-get-InsertionPoint obj)
                        sx (rtos (vla-get-XScaleFactor obj) 2 10)
                        sy (rtos (vla-get-YScaleFactor obj) 2 10)
                        sz (rtos (vla-get-ZScaleFactor obj) 2 10)
                        rot (rtos (vla-get-Rotation obj) 2 10)
                        tools (xrcv:tools-dir)
                        script (strcat tools "\\xr_copy_visible.py")
                        vpython (xrcv:python))
                  (cond
                    ((not (findfile script))
                      (prompt (strcat "\nXRCOPYVISIBLE: не найден скрипт: " script))
                    )
                    (T
                      (prompt "\nБудет скопирована собственная геометрия верхней ссылки.")
                      (prompt "\nВложенные ссылки (включая битые) будут пропущены.")
                      (initget "Yes No")
                      (if (/= (getkword "\nЗапустить копирование? [Yes/No] <No>: ") "Yes")
                        (prompt "\nXRCOPYVISIBLE: отменено. Ничего не изменено.")
                        (progn
                          (setq cmd (strcat "\"" vpython "\" \"" script "\" \""
                                            source "\" \"" target "\" "
                                            (xrcv:pt-value ip 0) " " (xrcv:pt-value ip 1) " " (xrcv:pt-value ip 2) " "
                                            sx " " sy " " sz " " rot))
                          (setq shell (vl-catch-all-apply 'vlax-create-object (list "WScript.Shell")))
                          (if (vl-catch-all-error-p shell)
                            (prompt (strcat "\nXRCOPYVISIBLE: ошибка WScript.Shell: " (vl-catch-all-error-message shell)))
                            (progn
                              (setq res (vl-catch-all-apply 'vlax-invoke (list shell "Run" cmd 0 0)))
                              (vlax-release-object shell)
                              (if (vl-catch-all-error-p res)
                                (prompt (strcat "\nXRCOPYVISIBLE: не запущено: " (vl-catch-all-error-message res)))
                                (progn
                                  (prompt "\nXRCOPYVISIBLE: запущено в фоне.")
                                  (prompt (strcat "\nЛог: " (getenv "TEMP") "\\xr_copy_visible_log.txt"))
                                  (prompt "\nПосле завершения визуально проверьте план и сохраните DWG."))
                              )
                            )
                          )
                        )
                      )
                    )
                  )
                )
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

(princ "\nXRCOPYVISIBLE.lsp загружен. Команда: XRCOPYVISIBLE")
(princ)