[编程交流] 多个布局选项卡。图纸

;; ObjectDBX Example, by Lee McDonnell
  
(defun ODBX (fname / doc dbx lst flag)
 (vl-load-com)
 (vlax-for doc (vla-get-Documents (vlax-get-acad-object))
   (and (eq (strcase (vla-get-fullname doc)) (strcase fname))
        (setq dbx doc)))
 (and (not dbx) (setq flag t)
      (setq dbx
        (vlax-create-object
          (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
            "ObjectDBX.AxDbDocument"
            (strcat "ObjectDBX.AxDbDocument." (itoa acVer))))))
 (cond ((and flag
          (vl-catch-all-error-p
            (vl-catch-all-apply 'vla-open
              (list dbx fname))))
        (princ (strcat "\n** Error Opening: " (vl-filename-base fname) " **")))
       (t
        (vlax-for lay (vla-get-Layouts dbx)
          (setq lst (cons (vla-get-name lay) lst)))))    
 (ObjRel (list dbx)) (gc) (gc)
 lst)
;; Release Objects ~ Requires List of Variables
           
(defun ObjRel (lst)
 (mapcar
   (function
     (lambda (x)
       (if (and (eq (type x) 'VLA-OBJECT)
                (not (vlax-object-released-p x)))
         (vl-catch-all-apply
           'vlax-release-object (list x))))) lst))
(defun c:test ( )
 (odbx (getfiled "select" "" "dwg" 16)))

 
(defun c:lstdwg(/ dirbox Ouvrir_dessin_dbx rep lst fic dbx lay)
 (defun dirbox(/ cdl rep)
   (if (setq cdl (vlax-create-object "Shell.Application"))
     (progn
   (and (setq rep (vlax-invoke cdl 'browseforfolder 0 "Choose a directory" 512 ""))
        (setq rep (vlax-get-property (vlax-get-property rep 'self) 'path))
   )
   (vlax-release-object cdl)
     )
   )
   rep
 )
 (defun Ouvrir_dessin_dbx(dwg / dbx doc lan)
   (vl-load-com) 
   (setq dwg (findfile dwg))
   (vlax-for doc (vla-get-documents (vlax-get-acad-object))
     (and (eq (strcase (vla-get-fullname doc)) (strcase dwg))
   (setq dbx doc lan T)
     )
   )
   (or dbx
     (progn
   (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
     (setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
     (setq dbx (vlax-create-object (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))
   )
   (vla-open dbx dwg)
     )
   )
   (list dbx lan)
 )
 (vl-load-com)
 (if (setq rep (dirbox))
   (if (setq lst (vl-directory-files rep "*.dwg" 1))
     (foreach fic lst
   (if (setq dbx (ouvrir_dessin_dbx (strcat rep "/" fic)))
     (progn
       (princ (strcat "\n Working in " fic))(princ)
       (vlax-for lay (vla-get-layouts (car dbx))
         (princ (strcat "\n\t\tLayout : " (vla-get-name lay)))(princ)
       )
       (or (cadr dbx)(vlax-release-object (car dbx)))
     )
     (princ (strcat "\n Can't read file " fic))
   )
     )
     (alert "No dwg's File")
   )
 )
 (princ)
)