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

Экспорт и импорт видов

Назад к списку функций
;;; viewsIO.lsp
;;;
;;; Экспорт и импорт видов
;;;
;;; c:ExportViews
;;; c:ImportViews
;;; c:-ExportViews
;;; c:-ImportViews
;;;
;;; Проверено на AutoCAD 2000-2004
;;; Не работает на более поздних версиях

(defun c:ExportViews (/ fn)
  (if (setq fn
             (getfiled "Экспортировать виды в"
                       (strcat (vl-filename-base (getvar "dwgname")) ".txt")
                       "txt"
                       1
             )
      )
    (ExportViews fn)
  )
  (princ)
)

(defun c:ImportViews (/ fn)
  (if (setq fn
             (getfiled "Импортировать виды в"
                       (strcat (vl-filename-base (getvar "dwgname")) ".txt")
                       "txt"
                       1
             )
      )
    (ImportViews fn)
  )
  (princ)
)

(defun c:-ExportViews (/ fn x)
  (setq fn (strcat (vl-filename-base (getvar "dwgname")) ".txt"))
  (if (setq fn
             (findfile
               (if (= ""
                      (setq nn (getstring
                                 T
                                 (strcat "Введите имя файла <"
                                         fn
                                         ">: "
                                 )
                               )
                      )
                   )
                 fn
                 nn
               )
             )
      )
    (progn
      (initget "Yes No")
      (setq x (getkword "\nФайл существует. Перезаписать? [Yes/No] : "))
      (if (= x "Yes") (ExportViews fn))
    )
    (princ "\nФайл не найлен.")
  )
  (princ)
)

(defun c:-ImportViews (/ fn)
  (setq fn (strcat (vl-filename-base (getvar "dwgname")) ".txt"))
  (if (setq fn
             (findfile
               (if (= ""
                      (setq nn (getstring
                                 T
                                 (strcat "Введите имя файла <"
                                         fn
                                         ">: "
                                 )
                               )
                      )
                   )
                 fn
                 nn
               )
             )
      )
    (ImportViews fn)
    (princ "\nФайл не найден.")
  )
  (princ)
)

(defun ExportViews (fn / e tl f ed)
  (while (setq e (tblnext "VIEW" (null e)))
    (setq tl (cons (cdr (assoc 2 e)) tl))
  )
  (setq f (open fn "w"))
  (if f
    (progn
      (princ "Следующие виды экспортированы:\n")
      (foreach view tl
        (setq ed (entget (tblobjname "view" view)))
        (prin1 (cons (cons 0 "VIEW") (cdddr ed)) f)
        (princ "\n" f)
        (prin1 view)
        (terpri)
      )
      (close f)
    )
  )
)

(defun ImportViews (fn / tl f)
  (setq f (open fn "r"))
  (if f
    (progn
      (princ "Следующие виды импортированы:\n")
      (while (setq tl (read-line f))
        (setq tl (read tl))
        (entmake tl)
        (print (cdr (assoc 2 tl)))
      )
      (close f)
    )
  )
)

(princ)



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