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