Логотип сайта поддержки пользователей САПРО сайте поддержки пользователей САПР Translate to:

Сохранение, загрузка и восстановление замороженных слоев из файла и их перемещение с одного видового экрана в другой

Назад к списку функций
;;;---------------------------------------------------------------------------;
;;;
;;; VPlayers.lsp
;;;
;;; Проверено на AutoCAD 2000
;;;
;;;---------------------------------------------------------------------------;
;;;  ОПИСАНИЕ
;;;
;;;  c:SaveVPlayers - сохраняет замороженные слои видовых экранов в файл
;;;  c:LoadVPlayers - загружает и восстанавливает замороженные слои видовых экранов из файл
;;;  c:CopyVPlayers - копирует параметры слоев с одного видового экрана в другой
;;;                   
;;;---------------------------------------------------------------------------;

(defun dxf (n ed) (cdr (assoc n ed)))

;;; возвращает список замороженных слоев в текущем видовом экране
;;; ex. (viewport-frozen-layer-list) -> ("Layer3" "Layer4")
;;; alt. with Express Tools (ACET-VIEWPORT-FROZEN-LAYER-LIST (ACET-CURRENTVIEWPORT-ENAME))
(defun viewport-frozen-layer-list (/ cvp)
  (if (= 0 (getvar "tilemode"))
    (if (/= 1 (setq cvp (getvar "cvport")))
      (apply
        'append
        (mapcar
          '(lambda (x)
             (if (= 1003 (car x))
               (list (cdr x))
             )
           )
          (cdadr
            (assoc
              -3
              (entget
                (ssname
                  (ssget "_X"
                         (list (cons 69 cvp) (cons 410 (getvar "ctab")))
                  )
                  0
                )
                '("acad")
              )
            )
          )
        )
      )
    )
  )
)

(defun GetVPlayers (/ ss ent vpno)
  (command "._pspace")
  (princ "\nВыберите видовой экран: ")
  (setq ss (ssget ":E:S" '((0 . "VIEWPORT"))))
  (if ss
    (progn
      (setq ent (ssname ss 0))
      (setq vpno (dxf 69 (entget ent)))
      (command "._mspace")
      (setvar "cvport" vpno)
      (viewport-frozen-layer-list)
    )
  )
)


(defun c:SaveVPlayers (/ fn oldcmdecho VAL f *error* restore layers)
  (defun *error* (str)
    (restore)
    (if str
      (prompt (strcat "Error: " str))
    )
    (princ)
  )
  (defun restore ()
    (command "._undo" "_E")
    (setvar "cmdecho" oldcmdecho)
  )

  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "._UNDO" "_BE")
  (cond
    ((not (equal 0 (getvar "tilemode")))
     (princ
       "\n  Команда не разрешена, так как TILEMODE установлена в 0  "
     )
    )
    ((> 2
        (sslength
          (ssget "_x"
                 (list (cons 0 "VIEWPORT") (cons 410 (getvar "ctab")))
          )
        )
     )
     (princ "\n  Команда работает только с одним или большим числом видовых экранов"
     )
    )
    ((not (setq fn
                 (getfiled "Сохранить слой видового экрана как"
                           (vl-filename-base (getvar "dwgname"))
                           "vpl"
                           1
                 )
          )
     )
    )
    ((not (setq f (open fn "w")))
     (princ "\n  Невозможно загрузить файл!")
    )
    (T
     (setq layers (GetVPlayers))
     (if layers
       (prin1 layers f)
       (princ "\n  Здесь нет замороженых VP-слоев.")
     )
     (command "._pspace")
     (close f)
    )
  )
  (restore)
  (princ)
)

(defun PutVPlayers (layers / VAL ss)
  (if layers
    (progn
      (princ "\nВыберите целевой видовой экран: ")
      (command "._pspace")
      (setq ss (ssget ":E" '((0 . "VIEWPORT"))))
      (if ss
        (progn
          (command "_.vplayer" "_thaw" "*" "_select" ss "")
          (foreach VAL layers (command "_freeze" VAL "_select" ss ""))
          (command "")
        )
      )
    )
  )
)

(defun c:LoadVPlayers (/ oldcmdecho fn tl lst *error* restore)
  (defun *error* (str)
    (restore)
    (if str
      (prompt (strcat "Error: " str))
    )
    (princ)
  )
  (defun restore ()
    (command "._undo" "_E")
    (setvar "cmdecho" oldcmdecho)
  )

  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "._UNDO" "_BE")
  (cond
    ((not (equal 0 (getvar "tilemode")))
     (princ
       "\n  Команда не разрешена, так как TILEMODE установлена в 0 "
     )
    )
    ((> 2
        (sslength
          (ssget "_x"
                 (list (cons 0 "VIEWPORT") (cons 410 (getvar "ctab")))
          )
        )
     )
     (princ "\n  Команда работает только с одним или большим числом видовых экранов "
     )
    )
    ((not (setq fn
                 (getfiled "Open ViewPort layer list"
                           (vl-filename-base (getvar "dwgname"))
                           "vpl"
                           0
                 )
          )
     )
    )
    ((not (setq f (open fn "r")))
     (princ "\n  Невозможно загрузить файл!")
    )
    (T
     (setq lst (read (read-line f)))
     (if (= (type lst) 'LIST)
       (PutVPlayers lst)
     )
     (command "._pspace")
     (close f)
    )
  )
  safe
  (restore)
  (princ)
)

(defun c:CopyVPlayers (/ oldcmdecho *error* restore layers)
  (defun *error* (str)
    (restore)
    (if str
      (prompt (strcat "Error: " str))
    )
    (princ)
  )
  (defun restore ()
    (command "._undo" "_E")
    (setvar "cmdecho" oldcmdecho)
  )

  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "._UNDO" "_BE")
  (cond
    ((not (equal 0 (getvar "tilemode")))
     (princ
       "\n  Команда не разрешена, так как TILEMODE установлена в 0 "
     )
    )
    ((> 3
        (sslength
          (ssget "_x"
                 (list (cons 0 "VIEWPORT") (cons 410 (getvar "ctab")))
          )
        )
     )
     (princ "\n  Команда работает только с одним или большим числом видовых экранов  "
     )
    )
    (T
     (setq layers (GetVPlayers))
     (if layers
       (PutVPlayers layers)
       (princ "\n  Здесь нет замороженных VP-слоев.")
     )
     (command "._pspace")
    )
  )
  (restore)
  (princ)
)

(princ)



Copyright © Сайт поддержки пользователей САПР by Victor Tkachenko