Здесь вы можете скачать документацию и программы для САПР AutoCAD, PCAD, 3DS, Inventor, Pro/E, Solidworks и других CAD CAM CAE EDA GIS

Создание отдельных чертежных файлов для всех листов

;;;    LayoutsToDwgs.lsp
;;;    для AutoCAD 2000, 2000i, 2002, 2004
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;   Создает отделные чертежи всех листов.
;;;   Одновременно сохраняется только один лист, остальные удаляются
;;;   это удобно когда вам необходимо сохранить чертеж AutoCAD в 
;;;   формате версии, более ранней чем AutoCAD 2000
;;;   Новые чертежи сохраняются в том же каталоге, гже находится
;;;   текущий чертеж и перезаписывают существующие чертежи
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:LayoutsToDwgs (/ fn path msg msg2 fileprefix)
  (defun DelAllLayouts (Keeper / TabName)
    (vlax-for Layout
                     (vla-get-Layouts
                       (vla-get-activedocument (vlax-get-acad-object))
                     )
      (if
        (and
          (/= (setq TabName (strcase (vla-get-name layout))) "MODEL")
          (/= TabName (strcase Keeper))
        )
         (vla-delete layout)
      )
    )
  )

  (vl-load-com)
  (setq msg "")
  (setq msg2 "")
  (command "._undo" "_BE")
  (setq fileprefix (getstring "Введите префикс имени файла: "))
  (foreach lay (layoutlist)
    (if (/= lay "Model")
      (progn
        (command "_.undo" "_M")
        (DelAllLayouts lay)
        (setvar "tilemode" 1)
        (command "ucs" "w")
        (setvar "tilemode" 0)
        (setq path (getvar "DWGPREFIX"))
        (setq fn (strcat path fileprefix lay ".dwg"))
        (if (findfile fn)
          (progn
            (command ".-wblock" fn "_Y")
            (if (equal 1 (logand 1 (getvar "cmdactive")))
              (progn
                (setq msg (strcat msg "\n" fn))
                (command "*")
              )
              (setq msg2 (strcat msg2 "\n" fn))
            )
          )
          (progn
            (command ".-wblock" fn "*")
            (setq msg (strcat msg "\n" fn))
          )
        )
        (command "_.undo" "_B")
      )
    )
  )
  (if (/= msg "")
    (progn
      (prompt "\nСледующие чертежные файлы были созданы:")
      (prompt msg)
    )
  )
  (if (/= msg2 "")
    (progn
      (prompt "\nСледующие чертежные файлы были НЕ созданы:")
      (prompt msg2)
    )
  )
  (command "._undo" "_E")
  (textscr)
  (princ)
)