[Krieger]

Как можно экспортировать лист из файла с множеством листов в отдельный файл с одним листом.
Т.е. нужно сделать копию файла и удалить все не нужные листы. И так с каждым листом. Сколько было листов в файле, столько должно получиться файлов.

[Nike]

...

Код:

[Выделить все]

 ;;;
;;;    LayoutsToDwgs.lsp
;;;    Created 2000-03-27

;;; By Jimmy Bergmark
;;; Copyright (C) 1997-2016 JTB World, All Rights Reserved
;;; Website: http://jtbworld.com
;;; E-mail: info@jtbworld.com
;;;
;;; 2003-12-12 Sets UCS to world in model space
;;;            to avoid problem with wblock
;;; 2011-06-06 Excludes empty layouts
;;; 2012-06-01 Handle Map prompt with WBLOCK
;;;             Include AutoCAD Map information in the export? [Yes/No] <Y>:
;;; 2013-03-04 Added _ on some commands to internationalize it
;;; 2015-12-01 Updated for AutoCAD 2015 and 2016
;;; 2016-10-26 Modified to also allow suffix
;;;
;;;    For AutoCAD 2000, 2000i, 2002, 2004, 2005, 
;;;    2006, 2007, 2008, 2009, 2011, 2012, 2013, 2014, 2015, 2016 and newer
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;   Creates separate drawings of all layouts.
;;;   The new drawings are saved to the current drawings path
;;;   and overwrites existing drawings.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:LayoutsToDwgs (/ errexit undox olderr oldcmdecho oldexpert oldcmddia fn path
                          msg msg2 fileprefix filesuffix i j)

  (defun errexit (s)
    (princ "\nError:  ")
    (princ s)
    (restore)
  )

  (defun undox ()
    (command "._undo" "_E")
    (setvar "cmdecho" oldcmdecho)
    (setvar "expert" oldexpert)
    (setvar "cmddia" oldcmddia)
    (setq *error* olderr)
    (princ)
  )

  (setq olderr  *error*
        restore undox
        *error* errexit
  )
  (setq oldcmdecho (getvar "cmdecho"))
  (setq oldexpert (getvar "expert"))
  (setq oldcmddia (getvar "cmddia"))
  (setvar "cmdecho" 0)
  (setvar "expert" 2)
  (setvar "cmddia" 0)
  (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 "" msg2 "" i 0 j 0)
  (command "._undo" "_BE")
  (setq fileprefix (getstring "Enter filename prefix: "))
  (setq filesuffix (getstring "Enter filename suffix: "))
  (foreach lay (layoutlist)
    (if (and (/= lay "Model") (> (vla-get-count (vla-get-block (vla-Item (vla-get-Layouts (vla-get-activedocument (vlax-get-acad-object))) lay))) 1))
      (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 filesuffix ".dwg"))
        (if (findfile fn)
          (progn
            (command "_.-wblock" fn)
            (if (equal 1 (logand 1 (getvar "cmdactive")))
              (progn
                (setq i (1+ i) msg (strcat msg "\n" fn))
                (command "*")
              )
              (setq j (1+ j) msg2 (strcat msg2 "\n" fn))
            )
          )
          (progn
            (command "_.-wblock" fn "*")
            (setq i (1+ i)  msg (strcat msg "\n" fn))
          )
        )
        (if (equal 1 (logand 1 (getvar "cmdactive")))
          ; Include AutoCAD Map information in the export?
          ; If you don't want to include Map information in the new files change "_Y" to "_N" below
          (command "_Y")
        )
        (command "_.undo" "_B")
      )
    )
  )
  (if (/= msg "")
    (progn
      (if (= i 1)
        (prompt "\nFollowing drawing was created:")
        (prompt "\nFollowing drawings were created:")
      )
      (prompt msg)
    )
  )
  (if (/= msg2 "")
    (progn
      (if (= j 1)
        (prompt "\nFollowing drawing was NOT created:")
        (prompt "\nFollowing drawings were NOT created:")
      )
      (prompt msg2)
    )
  )
  (command "._undo" "_E")
  (textscr)
  (restore)
  (princ)
)
(princ)

[Krieger]

Спасибо.
Совсем забыл, что wblock может весь чертеж сохранить...

[guerre1403]

Сообщение от Nike ... Код: ;;; ;;; LayoutsToDwgs.lsp ;;; Created 2000-03-27 ;;; By Jimmy Bergmark ;;; Copyright (C) 1997-2016 JTB World, All Rights Reserved ;;; Website: http://jtbworld.com ;;; E-mail: info@jtbworld.com ;;; ;;; 2003-12-12 Sets UCS to world in model space ;;; to avoid problem with wblock ;;; 2011-06-06 Excludes empty layouts ;;; 2012-06-01 Handle Map prompt with WBLOCK ;;; Include AutoCAD Map information in the export? [Yes/No] <Y>: ;;; 2013-03-04 Added _ on some commands to internationalize it ;;; 2015-12-01 Updated for AutoCAD 2015 and 2016 ;;; 2016-10-26 Modified to also allow suffix ;;; ;;; For AutoCAD 2000, 2000i, 2002, 2004, 2005, ;;; 2006, 2007, 2008, 2009, 2011, 2012, 2013, 2014, 2015, 2016 and newer ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Creates separate drawings of all layouts. ;;; The new drawings are saved to the current drawings path ;;; and overwrites existing drawings. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:LayoutsToDwgs (/ errexit undox olderr oldcmdecho oldexpert oldcmddia fn path msg msg2 fileprefix filesuffix i j) (defun errexit (s) (princ "\nError: ") (princ s) (restore) )

Все отлично работает. Подскажите как сделать так,чтобы в модели оставались только объекты, которые присутствуют на данном листе (надо удалить объекты, не принадлежащие данному листу)!

[Vov.Ka]

Сообщение от guerre1403 Подскажите как сделать так,чтобы в модели оставались только объекты, которые присутствуют на данном листе (надо удалить объекты, не принадлежащие данному листу)

https://www.theswamp.org/index.php?topic=52709.0

[guerre1403]

Сообщение от Vov.Ka https://www.theswamp.org/index.php?topic=52709.0

Ссылка на форум, регистрация и все такое...
Можете вкратце рассказать?

[Vov.Ka]

Сообщение от guerre1403 Можете вкратце рассказать?

по ссылке находится лисп, который делает то, что тебе нужно

[guerre1403]

Сообщение от Vov.Ka по ссылке находится лисп, который делает то, что тебе нужно

Скопируйте, пожалуйста, его сюда, если у вас есть доступ туда.

[Vov.Ka]

Сообщение от guerre1403 если у вас есть доступ туда.

theswamp.org это один из лучших (если не самый лучший) ресурс по автолиспу в мире
регистрируйся не бойся, не пожалеешь

[OKJI]

Сообщение от guerre1403 Скопируйте, пожалуйста, его сюда, если у вас есть доступ туда.

Я там нашел только вот этот лисп:

Код:

[Выделить все]

 (defun c:TabsToDwgs ( / doc opts dbxdoc err )
    (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (if (setq opts (t2d_dialog doc))
        (if (= (caar opts) "rbsel")
            (if
                (and
                    (findfile (cdar opts))
                    (setq dbxdoc
                        (if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
                            (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
                            (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
                        )
                    )
                    (not (setq err (vl-catch-all-apply (function vla-Open) (list dbxdoc (cdar opts) :vlax-true))))
                    (not (vl-catch-all-error-p err))
                )
                (tabsToDwgs dbxdoc (cadr opts) (caddr opts) (cadddr opts) t)
                (prompt (strcat "\n Could not open drawing: " (cdar opts)))
            )
            (tabsToDwgs doc (cadr opts) (caddr opts) (cadddr opts) nil)
        )
    )
    (if (and dbxdoc (not (vlax-object-released-p dbxdoc)))
        (vlax-release-object dbxdoc)
    )
    (setq dbxdoc nil)
    (princ)
)
;======================================================
; utility functions for debugging

(defun addpointms ( pt clr norm )
    (entmake (list '(0 . "POINT") '(100 . "AcDbEntity") '(410 . "Model")
        (cons 62 clr) '(100 . "AcDbPoint") (cons 10 pt) (cons 210 norm)))
)
(defun addplane (pts clr norm)
    (entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(410 . "Model")
        (cons 62 clr) '(100 . "AcDbLine") (cons 10 (car pts))
        (cons 11 (cadr pts)) (cons 210 norm)))
    (entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(410 . "Model")
        (cons 62 clr) '(100 . "AcDbLine") (cons 10 (cadr pts))
        (cons 11 (caddr pts)) (cons 210 norm)))
    (entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(410 . "Model")
        (cons 62 clr) '(100 . "AcDbLine") (cons 10 (caddr pts))
        (cons 11 (cadddr pts)) (cons 210 norm)))
    (entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(410 . "Model")
        (cons 62 clr) '(100 . "AcDbLine") (cons 10 (car pts))
        (cons 11 (cadddr pts)) (cons 210 norm)))
)
;======================================================
(defun t2d_dialog ( doc / dwgoptions nameoptions selectdrawing updateNamesList
                    createPatternList selectdirectory buildName
                    updatePatternList updatePreviewList applyPattern sort
                    separateStringdload stringtonumber numbertostring
                    dload mNames sel opt dwg dir tabopt tab )

    (defun dwgoptions ( / opt )
        (setq opt (if (= (get_tile "optdwg") "rbcur") 1 0))
        (mode_tile "ebpath" opt)
        (mode_tile "butpath" opt)
        (if (and (equal opt 0) (= (get_tile "ebpath") ""))
            (selectdrawing)
        )
        (updateNamesList t)
    )
;-------------------------------------------------------
    (defun nameoptions ( / opt )
        (setq opt (if (= (get_tile "optname") "rbtab") 1 0))
        (mode_tile "ebpat" opt)
        (mode_tile "butview" opt)
        (mode_tile "rbfile" opt)
        (updatePreviewList (createPatternList))
        (if (equal opt 0)
            (mode_tile "ebpat" 2)
            (if (= (get_tile "opttab") "rbfile") (set_tile "opttab" "rbtabs"))
        )
    )
;-------------------------------------------------------
    (defun selectdrawing ( / opt )
        (setq opt (getfiled "Select drawing to export tabs to drawings." (getvar 'DwgPrefix) "dwg" 4))
        (if opt
            (progn
                (set_tile "ebpath" opt)
                (updateNamesList t)
            )
        )
    )
;-------------------------------------------------------
    (defun selectdirectory ( / dir )
        (if (setq dir (Directory-Dia "Select output directory"))
            (set_tile "ebdir" dir)
        )
    )
;-------------------------------------------------------
    (defun Directory-Dia ( Message / sh folder folderobject result)
    ;; By Tony Tanzillo
    ;; Modified by Tim Willey
    ;; 16 Will let you type in the path
    ;; 64 Will let you create a new folder

        (vl-load-com)
        (setq sh
            (vla-getInterfaceObject
                (vlax-get-acad-object)
                "Shell.Application"
            )
        )


        (setq folder
            (vlax-invoke-method
                sh
                'BrowseForFolder
                (vla-get-HWND (vlax-get-Acad-Object))
                Message
                0 ; This is the bit number to change.
            )
        )
        (vlax-release-object sh)


        (if folder
            (progn
                (setq folderobject
                    (vlax-get-property folder 'Self)
                )
                (setq result
                    (vlax-get-property FolderObject 'Path)
                )
                (vlax-release-object folder)
                (vlax-release-object FolderObject)
                (if (/= (substr result (strlen result)) "\\")
                    (setq result (strcat result "\\"))
                    result
                )
            )
        )
    )
;-------------------------------------------------------
    (defun updateNamesList ( updatepreview / dbxdoc name path )
        (setq mNames nil)
        (if (= (get_tile "optdwg") "rbsel")
            (if (and (/= (setq path (get_tile "ebpath")) "") (findfile path))
                (progn
                    (setq dbxdoc
                        (if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
                            (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
                            (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
                        )
                    )
                    (vl-catch-all-apply (function vla-Open) (list dbxdoc path :vlax-true))
                    (vlax-for lo (vla-get-Layouts dbxdoc)
                        (setq name (vla-get-Name lo))
                        (if (/= name "Model") (setq mNames (cons (cons name name) mNames)))
                    )
                    (vlax-release-object dbxdoc)
                    (setq dbxdoc nil)
                )
            )
            (vlax-for lo (vla-get-Layouts doc)
                (setq name (vla-get-Name lo))
                (if (/= name "Model") (setq mNames (cons (cons name name) mNames)))
            )
        )
        (setq mNames (vl-sort mNames (function (lambda (a b) (sort < (strcase (car a)) (strcase (car b)))))))
        (if updatepreview (updatePreviewList (createPatternList)))
    )
;-------------------------------------------------------
    (defun createPatternList ( / pat strs lst )
        
        (defun updatePatternList ( strs delimstr / dlst char nst pos cnt lst )
            (setq dlst (strParse delimstr "="))
            (setq char (car dlst))
            (setq nst (cadr dlst))
            (if (= char "#") (setq nst (atoi nst)))
            (foreach s strs
                (if (and (equal (type s) 'STR) (setq pos (vl-string-search char s)))
                    (progn
                        (setq cnt pos)
                        (while (wcmatch (substr s (setq cnt (1+ cnt)) 1) (strcat "[" char "]")))
                        (setq lst
                            (append
                                lst
                                (list
                                    (substr s 1 pos)
                                    (list nst (- cnt pos 1))
                                    (substr s cnt)
                                )
                            )
                        )
                    )
                    (setq lst (append lst (list s)))
                )
            )
            lst
        )
    ;-------------------------------------------------------
        (setq pat (get_tile "ebpat"))
        (if (and (= (get_tile "optname") "rbpat") (/= pat ""))
            (progn
                (setq strs (strParse pat ";"))
                (setq lst (list (car strs)))
                (foreach i (cdr strs)
                    (setq lst (updatePatternList lst i))
                )
            )
        )
        lst
    )
;-------------------------------------------------------
    (defun updatePreviewList ( patlist / sel fac lst cnt )
        
        (defun buildName ( patlist fac / str )
            (setq str "")
            (foreach i patlist
                (setq str (strcat str (applyPattern i fac)))
            )
            str
        )
    ;-------------------------------------------------------
    ;; INCSUFF+ (version 1.0.0) -Gilles Chanteau- 09/03/10
    ;; Adds the specified increment to a string suffix.
    ;; Is considered as suffix, all [0-9], [A-Z] and [a-z] characters from
    ;; the end of the string according to flag value.
    ;;
    ;; Arguments
    ;; str  : a string
    ;; inc  : a positive integer
    ;; flag : an integer, the sum of following binary codes
    ;;       1 for numbers [0-9]
    ;;       2 for uppercase  [A-Z]
    ;;       4 for lowercase [a-z]
    ;; sep  : a character, "" or nil for nono
    ;;
    ;; Return
    ;; The string with incremented suffix (or nil if none valid suffix)
    ;;
    ;; Examples :
    ;; (incsuff+ "N°002" 12 1 "") = "N°014"
    ;; (incsuff+ "Dessin 9" 1 1 nil) = "Dessin 10"
    ;; (incsuff+ "B_ZZ9" 1 1 nil) = "B_ZZ10"
    ;; (incsuff+ "B_ZZ9" 1 3 nil) = "B_AAA0"
    ;; (incsuff+ "B_ZZ9" 1 3 "_") = "C_AA0"
    ;; (incsuff+ "1.2.9.9" 1 1 ".") = "1.3.0.0"
    ;; (incsuff+ "PK3+900" 100 1 "+") = "PK4+000"

    (defun incsuff+	(str	inc    alpha  sep    /	    number upper
             lower	lst    crt    pas    ind    val	   quo
             ret
            )
      (defun number (x) (and (< 47 x 58) (= 1 (logand 1 alpha))))
      (defun upper (x) (and (< 64 x 91) (= 2 (logand 2 alpha))))
      (defun lower (x) (and (< 96 x 123) (= 4 (logand 4 alpha))))
      (setq	lst (reverse (vl-string->list str))
        sep (if	sep
              (ascii sep)
              0
            )
      )
      (while
        (and
          (setq crt (car lst))
          (if (= sep crt)
        (if (or
              (setq num (number (cadr lst)))
              (setq upr (upper (cadr lst)))
              (setq lwr (lower (cadr lst)))
            )
          (setq	lst (cdr lst)
            crt (car lst)
            ret (cons sep ret)
          )
          T
        )
        (or
          (setq num (number crt))
          (setq upr (upper crt))
          (setq lwr (lower crt))
          T
        )
          )
          (cond
        (num
         (setq pas 10
               ind 48
         )
        )
        (upr
         (setq pas 26
               ind 65
         )
        )
        (lwr
         (setq pas 26
               ind 97
         )
        )
        ((< 0 quo)
         (setq crt (if (= 10 pas)
                 ind
                 (1- ind)
               )
               lst (cons (car lst) lst)
         )
        )
          )
        )
         (setq val (- crt ind)
           quo (/ (+ val inc) pas)
           ret (cons (+ ind (rem (+ val inc) pas)) ret)
         )
         (if (zerop quo)
           (setq ret (append (reverse (cdr lst)) ret)
             lst nil
           )
           (if (cdr lst)
         (setq lst (cdr lst)
               inc quo
         )
         (setq lst (list ind)
               inc (if (= 10 pas)
                 quo
                 (1- quo)
               )
         )
           )
         )
      )
      (if ret
        (vl-list->string ret)
      )
    )
    ;-------------------------------------------------------
        (defun stringtonumber ( str st / len cnt num n s )
            (setq len (strlen str))
            (setq cnt 1)
            (setq num 0.)
            (repeat len
                (setq n (- len cnt))
                (setq s (ascii (substr str cnt 1)))
                (setq num
                    (if (or (zerop num) (> s st))
                        (+ num (if (zerop n) (- s st) (* (+ (if (zerop num) 1 0) (- s st)) (expt 26 n))))
                        num
                    )
                )
                (setq cnt (1+ cnt))
            )
            num
        )
    ;-------------------------------------------------------
        (defun numbertostring ( num st / len s base n num )
            (setq len (if (zerop num) 0 (fix (/ (log num) (log 26)))))
            (setq s "")
            (repeat len
                (setq base (expt 26 len))
                (setq n (fix (/ num base)))
                (setq s (strcat s (chr (+ st (- n (if (zerop n) 0 1))))))
                (setq num (- num (* n base)))
            )
            (strcat s (chr (+ st (rem (fix num) 26))))
        )
    ;-------------------------------------------------------
        (defun applyPattern ( pat fac / opt st end )
            (cond
                ((equal (type pat) 'STR) pat)
                ((equal (type (setq opt (car i))) 'INT)
                    (setq opt (+ opt fac))
                    (setq pat (itoa opt))
                    (repeat (- (cadr i) (fix (/ (log opt) (log 10))) 1)
                        (setq pat (strcat "0" pat))
                    )
                    pat
                )
                ((equal (type opt) 'STR)
                    ; (if (<= "a" (substr opt 1 1) "z")
                    ;     (setq st (ascii "a") end (ascii "z"))
                    ;     (setq st (ascii "A") end (ascii "Z"))
                    ; )
                    ; (setq num (stringtonumber opt st))
                    ; (setq num (+ num fac))
                    ; (numbertostring num st)
                    (IncSuff+ opt fac 4 nil)
                )
            )
        )
    ;-------------------------------------------------------
        (if patlist
            (progn
                (setq sel (get_tile "lbnames"))
                (setq fac 0)
                (if (= sel "")
                    (foreach i mNames
                        (setq lst (cons (cons (car i) (buildName patList fac)) lst))
                        (setq fac (1+ fac))
                    )
                )
                (setq mNames (reverse lst))
            )
            (setq mNames (mapcar (function (lambda (x) (cons (car x) (car x)))) mNames))
        )
        (start_list "lbnames" 3)
        (foreach i mNames
            (add_list (strcat (car i) "\t -> \t" (cdr i)))
        )
        (end_list)
    )
;-------------------------------------------------------
    (defun sort ( fun a b / cnt s isnum o out )
        (defun separateString ( str / cnt s isnum o out )
            (setq cnt 1)
            (setq s (substr str cnt 1))
            (setq isnum (or (<= 48 (ascii s) 57) (= s ".")))
            (setq o s)
            (while (/= (setq s (substr str (setq cnt (1+ cnt)) 1)) "")
                (if isnum
                    (if (or (<= 48 (ascii s) 57) (= s "."))
                        (setq o (strcat o s))
                        (setq out
                                (cons
                                    (if (vl-string-search "." o)
                                        (atof o)
                                        (atoi o)
                                    )
                                    out
                                )
                            o s
                            isnum nil
                        )
                    )
                    (if (<= 48 (ascii s) 57)
                        (setq out (cons o out) o s isnum t)
                        (setq o (strcat o s))
                    )
                )
            )
            (reverse
                (cons
                    (if isnum
                        (if (vl-string-search "." o) (atof o) (atoi o))
                        o
                    )
                    out
                )
            )
        )
    ;-------------------------------------------------------
        (setq a (separateString a))
        (setq b (separateString b))
        (while (and a b (equal (car a) (car b))) (setq a (cdr a) b (cdr b)))
        (fun (car a) (car b))
    )
;-------------------------------------------------------
    (updateNamesList nil)
    (setq dload (load_dialog "MyDialogs.dcl"))
    (if (new_dialog "TabsToDrawings" dload)
        (progn
            (set_tile "title" "Tabs to Drawings [v1.3]")
            (updatePreviewList (createPatternList))
            (set_tile "optdwg" "rbcur")
            (dwgoptions)
            (set_tile "optname" "rbtab")
            (nameoptions)
            (set_tile "ebdir" (getvar 'DwgPrefix))
            (set_tile "opttab" "rblo1")
            
            (action_tile "optdwg" "(dwgoptions)")
            (action_tile "optname" "(nameoptions)")
            (action_tile "ebpat" "(if (equal $reason 1) (updatePreviewList (createPatternList)))")
            (action_tile "butpath" "(selectdrawing)")
            (action_tile "butdir" "(selectdirectory)")
            (action_tile "butview" "(updatePreviewList (createPatternList))")
            (action_tile
                "butok"
                "(progn
                    (setq opt (get_tile \"optdwg\"))
                    (setq dwg (get_tile \"ebpath\"))
                    (setq sel (get_tile \"lbnames\"))
                    (setq dir (get_tile \"ebdir\"))
                    (setq tabopt (get_tile \"opttab\"))
                    (setq tab
                        (cond
                            ((= tabopt \"rblo1\") nil)
                            ((= tabopt \"rbtabs\") 1)
                            ((= tabopt \"rbfile\") 2)
                        )
                    )
                    (done_dialog 1)
                )"
            )
            (if (equal (start_dialog) 1)
                (list
                    (cons opt dwg) ; opt-current/select, dwg-path
                    (if (= sel "") ; layout name list
                        mNames
                        (mapcar (function (lambda (x) (nth x mNames))) (read (Strcat "(" sel ")")))
                    )
                    tab ; tab nameing option: nil=Layout1, 1=as tabs, 2=as pattern
                    dir ; output directory
                )
            )
        )
    )
)

;======================================================

(defun tabsToDwgs ( doc dolist nameopt dir needrelease / *error* doesIntersect
                    getBoundingPoints isWithinCross getViewPoints findLike
                    doesPropertyMatch pointsEnclose getcreatelayout
                    setproperties
                    acname name lst vplist fvp lolist msobjs bpts vp
                    tlist olist cnt svname dbxdoc oVer objs err polist laycol
                    obj lay lock lo olo loname )
;-------------------------------------------------------
    (defun *error* (msg)
        (if dbxdoc (vlax-release-object dbxdoc))
        (if (and doc needrelease) (vlax-release-object doc))
        (if msg (vl-bt))
    )
;-------------------------------------------------------
    (defun doesIntersect ( pt pt2 pts on )
        (or
            (inters pt pt2 (car pts) (cadr pts) on)
            (inters pt pt2 (cadr pts) (caddr pts) on)
            (inters pt pt2 (caddr pts) (cadddr pts) on)
            (inters pt pt2 (car pts) (cadddr pts) on)
        )
    )
;-------------------------------------------------------
    (defun getBoundingPoints ( obj / ll ur err )
        (cond
            ((= (vla-get-ObjectName obj) "AcDbXline")
               (list
                   (vlax-get obj 'BasePoint)
                   (vlax-get obj 'SecondPoint)
               ) 
            )
            (t
                (setq err
                    (vl-catch-all-apply
                        (function vla-GetBoundingBox)
                        (list obj 'll 'ur)
                    )
                )
                (if
                    (not
                        (and
                            (vl-catch-all-error-p err)
                            (= (vl-catch-all-error-message err)
                                "Automation Error. Null extents")
                        )
                    )
                    (progn
                        (setq ll (safearray-value ll))
                        (setq ur (safearray-value ur))
                        (list
                            ll
                            (list (car ll) (cadr ur) (caddr ll))
                            ur
                            (list (car ur) (cadr ll) (caddr ll))
                        )
                    )
                )
            )
        )
    )
;-------------------------------------------------------
    (defun pointsEnclose ( outside inside / xc yc zc omin omax imin imax )
        (setq omin (min (caar outside) (caadr outside) (caaddr outside) (caar (cdddr outside))))
        (setq omax (max (caar outside) (caadr outside) (caaddr outside) (caar (cdddr outside))))
        (setq imin (min (caar inside) (caadr inside) (caaddr inside) (caar (cdddr inside))))
        (setq imax (max (caar inside) (caadr inside) (caaddr inside) (caar (cdddr inside))))
        (setq xc (and (<= omin imin omax) (<= omin imax omax)))

        (setq omin (min (cadar outside) (cadadr outside) (cadar (cddr outside)) (cadar (cdddr outside))))
        (setq omax (max (cadar outside) (cadadr outside) (cadar (cddr outside)) (cadar (cdddr outside))))
        (setq imin (min (cadar inside) (cadadr inside) (cadar (cddr inside)) (cadar (cdddr inside))))
        (setq imax (max (cadar inside) (cadadr inside) (cadar (cddr inside)) (cadar (cdddr inside))))
        (setq yc (and (<= omin imin omax) (<= omin imax omax)))

        (setq omin (min (caddar outside) (caddr (cadr outside)) (caddr (caddr outside)) (caddar (cdddr outside))))
        (setq omax (max (caddar outside) (caddr (cadr outside)) (caddr (caddr outside)) (caddar (cdddr outside))))
        (setq imin (min (caddar inside) (caddr (cadr inside)) (caddr (caddr inside)) (caddar (cdddr inside))))
        (setq imax (max (caddar inside) (caddr (cadr inside)) (caddr (caddr inside)) (caddar (cdddr inside))))
        (setq zc (and (<= omin imin omax) (<= omin imax omax)))

        (and xc yc zc)
    )
;-------------------------------------------------------
    (defun isWithinCross ( opts vpts vnorm )
        (setq opts (mapcar (function (lambda (x) (ProjectPointOnPlane x vnorm (car vpts) vnorm))) opts))
        ; (foreach pt opts (addpointms pt 5 vnorm))
        ; (foreach pt vpts (addpointms pt 1 vnorm))
        ; (addplane vpts 1 vnorm)
        (if (equal (length opts) 2)
            (doesIntersect (car opts) (cadr opts) vpts nil) 
            (progn
                (or
                    (pointsEnclose opts vpts)
                    (pointsEnclose vpts opts)
                    (doesIntersect (car opts) (cadr opts)  vpts t)
                    (doesIntersect (cadr opts) (caddr opts)  vpts t)
                    (doesIntersect (caddr opts) (cadddr opts)  vpts t)
                    (doesIntersect (cadddr opts) (car opts)  vpts t)
                )
            )
        )
    )
;-------------------------------------------------------
    (defun getViewPoints ( vp / ll ur )
        (vla-GetBoundingBox vp 'll 'ur)
        (setq ll (safearray-value ll))
        (setq ur (safearray-value ur))
        (mapcar
            (function
                (lambda (x) (PCS2WCS x vp))
            )
            (list
                ll
                (list (car ll) (cadr ur) (caddr ll))
                ur
                (list (car ur) (cadr ll) (caddr ur))
            )
        )
    )
;-------------------------------------------------------
    (defun doesPropertyMatch ( o1 o2 prop )
        (equal (vlax-get o1 prop) (vlax-get o2 prop))
    )
;-------------------------------------------------------
    (defun findLike ( src olist / obj )
        (foreach o olist
            (if
                (and
                    (doesPropertyMatch src o "ObjectName")
                    (doesPropertyMatch src o "Center")
                    (doesPropertyMatch src o "CustomScale")
                    (doesPropertyMatch src o "Direction")
                    (doesPropertyMatch src o "Height")
                    (doesPropertyMatch src o "TwistAngle")
                    (doesPropertyMatch src o "Width")
                )
                (setq obj o)
            )
        )
        obj
    )
;-------------------------------------------------------
    ;; WCS2PCS (gile)
    ;; Translates a point WCS coordinates to the PaperSpace CS according to
    ;; the specified Viewport
    ;; 
    ;; (WCS2PCS pt vp) is the same as (trans (trans pt 0 2) 2 3) when vp is active
    ;;
    ;; Arguments
    ;; pt : a point
    ;; vp : the viewport (ename or vla-object)

    (defun WCS2PCS (pt vp / elst ang nor scl mat)
      (vl-load-com)
      (and (= (type vp) 'VLA-OBJECT)
           (setq vp (vlax-vla-object->ename vp))
      )
      (setq	pt   (trans pt 0 0)
        elst (entget vp)
        ang  (cdr (assoc 51 elst))
        nor  (cdr (assoc 16 elst))
        scl  (/ (cdr (assoc 41 elst)) (cdr (assoc 45 elst)))
        mat  (mxm
               (list (list (cos ang) (- (sin ang)) 0.0)
                 (list (sin ang) (cos ang) 0.0)
                 '(0.0 0.0 1.0)
               )
               (mapcar (function (lambda (v) (trans v nor 0 T)))
                   '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
               )
             )
      )
      (mapcar '+
          (vxs (mxv mat (mapcar '- pt (cdr (assoc 17 elst)))) scl)
          (vxs (cdr (assoc 12 elst)) (- scl))
          (cdr (assoc 10 elst))
      )
    )
    ;; PCS2WCS (gile)
    ;; Translates a point PaperSpace coordinates to WCS coordinates
    ;; according to the specified viewport
    ;;
    ;; (PCS2WCS pt vp) is the same as (trans (trans pt 3 2) 2 0) when vp is active
    ;;
    ;; Arguments
    ;; pt : a point
    ;; vp : the viewport (ename or vla-object)

    (defun PCS2WCS (pt vp / ang nor scl mat)
      (vl-load-com)
      (and (= (type vp) 'VLA-OBJECT)
           (setq vp (vlax-vla-object->ename vp))
      )
      (setq	pt   (trans pt 0 0)
        elst (entget vp)
        ang  (- (cdr (assoc 51 elst)))
        nor  (cdr (assoc 16 elst))
        scl  (/ (cdr (assoc 45 elst)) (cdr (assoc 41 elst)))
        mat  (mxm
               (mapcar (function (lambda (v) (trans v 0 nor T)))
                   '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
               )
               (list (list (cos ang) (- (sin ang)) 0.0)
                 (list (sin ang) (cos ang) 0.0)
                 '(0.0 0.0 1.0)
               )
             )
      )
      (mapcar '+
          (mxv mat
               (mapcar '+
                   (vxs pt scl)
                   (vxs (cdr (assoc 10 elst)) (- scl))
                   (cdr (assoc 12 elst))
               )
          )
          (cdr (assoc 17 elst))
      )
    )

    ;; VXS Multiply a vector by a scalar
    ;;
    ;; Arguments : a vector and a real

    (defun vxs (v s) (mapcar (function (lambda (x) (* x s))) v))

    ;; VXV (gile)
    ;; Returns the dot product of two vectors (real)
    ;;
    ;; Arguments : two vectors
    ;; return : a real number

    (defun vxv (v1 v2) (apply '+ (mapcar '* v1 v2)))

    ;; TRP
    ;; transposes a matrix -Doug Wilson-
    ;;
    ;; Argument : a matrix
    ;; return : a matrix

    (defun trp (m) (apply 'mapcar (cons 'list m)))

    ;; MXV
    ;; Applies a transformation matrix to a vector  -Vladimir Nesterovsky-
    ;;
    ;; Arguments : une matrice et un vecteur
    ;; return : a vector

    (defun mxv (m v)
      (mapcar '(lambda (r) (vxv r v)) m)
    )

    ;; MXM
    ;; Multiplies (combinates) two matrices -Vladimir Nesterovsky-
    ;;
    ;; Arguments : deux matrices
    ;; return : a matrix

    (defun mxm (m q)
      (mapcar '(lambda (r) (mxv (trp q) r)) m)
    )

    (defun ProjectPointOnPlane (pt dir org nor / scl)
        ;; ProjectPointOnPlane (gile)
        ;; Returns the projected point on the specified plane
        ;;
        ;; Arguments
        ;; pt: the point to be projected
        ;; dir: the projection direction vector
        ;; org: a point on the projection plane
        ;; nor: the projection plane normal vector
        (if
            (and
                (not (equal 0. (setq scl (vxv nor dir))))
                (setq scl (/ (vxv nor (mapcar (function -) pt org)) scl))
            )
            (mapcar (function +) pt (mapcar (function (lambda (x) (* x (- scl)))) dir))
        )
    )
;-------------------------------------------------------
    (defun GetVlaAtoms ( )
        ; By: Michael Puckett
        (vl-remove-if-not
            '(lambda (symbol)    
                (wcmatch 
                    (vl-symbol-name symbol) 
                    "vla-*"
                )
            )
            (atoms-family 0)
        )
    )
    (defun GetVlaProperties ( atoms )
        ; By: Michael Puckett
        (vl-sort
            (mapcar
                '(lambda (symbolname) (substr symbolname 9))
                (vl-remove-if-not
                    '(lambda (symbolname)    
                        (wcmatch 
                            symbolname 
                            "vla-get-*" ;; don't need 'put'
                        )
                    )
                    (mapcar 'vl-symbol-name atoms)
                )
            )
            '<
        )    
    )
    (defun generatelayoutpropslist ( / lo lst )
        (setq lo (vla-get-Layout (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-Acad-Object)))))
        (foreach prop (GetVlaProperties (GetVlaAtoms))
            (if (vlax-property-available-p lo prop t)
                (setq lst (cons prop lst))
            )
        )
        lst
    )
;-------------------------------------------------------
    (defun setproperties ( nlo olo / proplist err )
        (setq proplist '("ViewToPlot" "UseStandardScale" 
            "StyleSheet" "StandardScale" "ShowPlotStyles" "ScaleLineweights"
            "PlotWithPlotStyles" "PlotWithLineweights" "PlotViewportsFirst"
            "PlotViewportBorders" "PlotType" "PlotRotation" "PlotOrigin"
            "PlotHidden" "PaperUnits" "ConfigName" "CenterPlot"
            "CanonicalMediaName")
        )
        ; removed from proplist: Name, TabOrder
        (foreach prop proplist
            (setq err (vl-catch-all-apply (function vlax-put) (list nlo prop (vlax-get olo prop))))
            ; (if (vl-catch-all-error-p err) (print prop))
        )
    )
;-------------------------------------------------------
    (defun getcreatelayout ( doc name / lo los )
        (vlax-for l (setq los (vla-get-Layouts doc))
            (if (= (vla-get-Name l) name) (setq lo l))
        )
        (if (not lo) (setq lo (vla-Add los name)))
        lo
    )
;-------------------------------------------------------
    (if (not (member (substr dir (strlen dir)) '("\\" "/")))
        (setq dir (strcat dir "/"))
    )
    (setq acname (vla-get-Name (vla-get-Layout (vla-get-PaperSpace doc))))
    (vlax-for lo (vla-get-Layouts doc)
        (setq name (vla-get-Name lo))
        (if (or (= name "Model") (assoc name dolist))
            (progn
                (setq lst nil)
                (setq vplist nil)
                (setq fvp nil)
                (vlax-for o (vla-get-Block lo)
                    (setq lst (cons o lst))
                    (if (and
                            (equal (vla-get-ModelType lo) :vlax-false)
                            (= (vla-get-ObjectName o) "AcDbViewport")
                        )
                        (setq vplist (cons (cons o (getViewPoints o)) vplist))
                    )
                    (if (and vplist (not fvp))
                        (progn
                            (setq fvp t)
                            (setq vplist nil)
                            (setq lst (vl-remove o lst))
                        )
                    )
                )
                (setq lolist
                    (cons
                        (list
                            name
                            (cons "layout" lo)
                            (cons "objects" lst)
                            (cons "viewports" vplist)
                        )
                        lolist
                    )
                )
            )
        )
    )
    (setq msobjs (cdr (assoc "objects" (cdr (assoc "Model" lolist)))))
    (foreach o msobjs
        (if (setq bpts (getBoundingPoints o))
            (foreach l lolist
                (setq name (car l))
                (foreach vp (cdr (assoc "viewports" (cdr l)))
                    (if (isWithinCross bpts (cdr vp) (vlax-get (car vp) 'Direction))
                        (if (setq tlist (assoc name olist))
                            (if (not (vl-position o (cdr tlist)))
                                (setq olist
                                    (subst
                                        (cons name (cons o (cdr tlist)))
                                        tlist
                                        olist
                                    )
                                )
                            )
                            (setq olist (cons (list name  o) olist))
                        )
                    )
                )
            )
        )
    )
    (setq cnt 0)
    (foreach l lolist
        (setq name (car l))
        (if (and (/= name "Model") (setq polist (cdr (assoc "objects" (cdr l)))))
            (progn
                (setq svname (cdr (assoc name dolist)))
                (setq dbxdoc
                    (if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
                        (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
                        (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
                    )
                )
                (if (setq tlist (cdr (assoc name olist)))
                    (vlax-invoke doc 'CopyObjects tlist (vla-get-ModelSpace dbxdoc))
                )
                ; this is needed if when working with the last active paperspace
                (if (= name acname)
                    (setq vp (vlax-invoke (vla-get-PaperSpace dbxdoc) 'AddpViewport '(0. 0. 0.) 1. 1.))
                )
                (setq loname
                    (cond
                        ((not nameopt) "Layout1")
                        ((equal nameopt 1) name)
                        ((equal nameopt 2)
                            (if (= name acname)
                                (progn
                                    (prompt (strcat "\n Error: layout creation: will use Layout1 in " svname ".dwg"))
                                    "Layout1"
                                )
                                svname
                            )
                        )
                        (t "Layout1")
                    )
                )
                (setq olo (cdr (assoc "layout" (cdr l))))
                (if (= loname name) 
                    (vlax-invoke doc 'CopyObjects (list olo) (vla-get-Layouts dbxdoc))
                    (progn
                        (setq lo (getcreatelayout dbxdoc loname))
                        (vlax-invoke doc 'CopyObjects polist (vla-get-Block lo))
                        (setproperties lo olo)
                    )
                )
                (if vp (vla-Delete vp))
                (setq err
                    (vl-catch-all-apply
                        (function vla-SaveAs)
                        (list dbxdoc (strcat dir svname ".dwg"))
                    )
                )
                (if (vl-catch-all-error-p err)
                    (prompt (strcat "\n Error: saving: " dir svname ".dwg"))
                    (setq cnt (1+ cnt))
                )
                ; if the last active paperspace, then need to turn on the
                ; viewports, but only if the whole layout was not copied
                (if (and vp (not (vl-catch-all-error-p err)) (/= loname name))
                    (progn
                        (vla-Open dbxdoc (strcat dir svname ".dwg"))
                        (setq laycol (vla-get-Layers dbxdoc))
                        (vlax-for o (vla-get-Block (getcreatelayout dbxdoc loname))
                            (if
                                (and
                                    (= (vla-get-ObjectName o) "AcDbViewport")
                                    (setq obj (findLike o polist))
                                )
                                (progn
                                    (setq lay (vla-Item laycol (vla-get-Layer o)))
                                    (setq lock (vla-get-Lock lay))
                                    (vla-put-Lock lay :vlax-false)
                                    (vla-put-ViewportOn o (vla-get-ViewportOn obj))
                                    (vla-put-Lock lay lock)
                                )
                            )
                        )
                        (setq err
                            (vl-catch-all-apply
                                (function vla-SaveAs)
                                (list dbxdoc (strcat dir svname ".dwg"))
                            )
                        )
                        (if (vl-catch-all-error-p err)
                            (prompt (strcat "\n Error: saving: " dir svname ".dwg"))
                        )
                    )
                )
                (setq vp nil)
                (vlax-release-object dbxdoc)
                (setq dbxdoc nil)
            )
        )
 
    )
    (prompt (strcat "\n Drawings created: " (itoa cnt)))
    (*error* nil)
    (princ)
)

Но как советует Vov.Ka, действительно зарегистрируйся не пожалеешь...

[guerre1403]

Сообщение от OKJI Я там нашел только вот этот лисп:

Спасибо! Я зарегистрировался в итоге) Возможно ли сделать подобный лисп без диалогового окна (чтобы все через командную строку было)