Newer
Older
SPIS / SPIS_SYSTEM_SETS.lsp
;;; SPIS_SYSTEM_SETS.lsp
;;; SPISATTACHSETS — подключает АР и все дисциплины комплекта в открытый СПИС.
;;;
;;; Ожидаемая структура (все DWG лежат по своим папкам):
;;;   <корень>\АР\<...>.dwg      — основа, ничего не подключает
;;;   <корень>\ЭТР\<...>.dwg     — содержит АР + смежные дисциплины
;;;   <корень>\СС\<...>.dwg
;;;   <корень>\ВК\<...>.dwg
;;;   <корень>\ОВ\<...>.dwg
;;;
;;; В СПИС подключаются АР и все четыре дисциплины.
;;; Тип ссылки — Overlay, точка вставки 0,0,0, масштаб 1:1, поворот 0.
;;; Уже подключённые ссылки пропускаются, ничего не перезаписывается.
;;;
;;; ВАЖНО: AttachExternalReference принадлежит ModelSpace, а НЕ коллекции
;;; Blocks. Проверено на AutoCAD 2020: у Blocks такого метода нет,
;;; вызов у Blocks даёт «неизвестное имя: AttachExternalReference».

(vl-load-com)

(defun sxs:blocks ( / doc)
  (vla-get-Blocks (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
)

(defun sxs:modelspace ()
  (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
)

;; Существует ли уже блок-ссылка с таким именем.
(defun sxs:exists-xref (name / blk)
  (setq blk (vl-catch-all-apply 'vla-Item (list (sxs:blocks) name)))
  (and (not (vl-catch-all-error-p blk)) (= :vlax-true (vla-get-IsXRef blk)))
)

;; Подключить один файл. Возвращает (STATUS name [message]).
;; Проверка «уже подключено» идёт ДО вызова: после успешного attach
;; блок уже считается xref-ссылкой, и проверка дала бы ложный SKIP.
(defun sxs:attach-one (file / name res)
  (setq name (vl-filename-base file))
  (cond
    ((sxs:exists-xref name) (list "SKIP" name))
    (T
      ;; метод вызывается у ModelSpace — см. примечание в заголовке
      (setq res (vl-catch-all-apply 'vla-AttachExternalReference
                  (list (sxs:modelspace) file name
                        (vlax-3d-point 0.0 0.0 0.0)
                        1.0 1.0 1.0 0.0 :vlax-true)))
      (cond
        ((vl-catch-all-error-p res)
          (list "ERROR" name (vl-catch-all-error-message res)))
        (T
          ;; Подтверждаем результат: блок стал xref-ссылкой?
          (if (sxs:exists-xref name)
            (list "OK" name)
            (list "ERROR" name "ссылка не появилась в чертеже")
          )
        )
      )
    )
  )
)

(defun c:SPISATTACHSETS (/ root sections section folder files file res ok skip err)
  (setq root (vl-string-right-trim "\\/"
               (getstring T "\nКорень проекта (папки АР, ЭТР, СС, ВК, ОВ): ")))
  (cond
    ((not (vl-file-directory-p root))
      (prompt "\nПапка не найдена. Ничего не изменено.")
    )
    (T
      ;; АР подключается в СПИС первым, затем все дисциплины комплекта.
      (setq sections (list "АР" "ЭТР" "СС" "ВК" "ОВ"))
      (setq files nil)
      (foreach section sections
        (setq folder (strcat root "\\" section))
        (if (vl-file-directory-p folder)
          (foreach file (vl-directory-files folder "*.dwg" 1)
            (setq files (cons (strcat folder "\\" file) files))
          )
        )
      )
      (setq files (reverse files))
      (cond
        ((not files)
          (prompt "\nВ папках дисциплин не найдено DWG. Ничего не изменено.")
        )
        (T
          (prompt (strcat "\nБудет подключено файлов: " (itoa (length files))))
          (foreach file files (prompt (strcat "\n  " file)))
          (initget "Yes No")
          (if (/= (getkword "\nПодключить эти файлы? [Yes/No] <No>: ") "Yes")
            (prompt "\nОтменено. Ничего не изменено.")
            (progn
              (foreach file files
                (setq res (sxs:attach-one file))
                (cond
                  ((= (car res) "OK")    (setq ok   (1+ (if ok ok 0))))
                  ((= (car res) "SKIP")  (setq skip (1+ (if skip skip 0))))
                  (T (setq err (1+ (if err err 0)))
                     (prompt (strcat "\nОшибка: " (cadr res) " - " (caddr res))))
                )
              )
              (prompt (strcat "\nГотово. Подключено=" (itoa (if ok ok 0))
                              ", пропущено=" (itoa (if skip skip 0))
                              ", ошибок=" (itoa (if err err 0))))
            )
          )
        )
      )
    )
  )
  (princ)
)

(prompt "\nSPIS_SYSTEM_SETS загружен. Команда: SPISATTACHSETS")
(princ)