多文件批量打印,程序只能打印当前的dwg文件，求网友查错。

yingwuluo

简易的多文件批量打印
1.预先设置好页面设置ps1
2.按照ps1打印打开的几个dwg文件
问题是，程序只能打印当前的dwg文件，求网友查错。

(defun ax:2dpoint (pt)
  (vlax-make-variant
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbdouble '(0 . 1))
      (list (car pt) (cadr pt))
    )
  )
)

(defun objs-lst        (objs)
  (setq obj-lst nil)
  (vlax-for obj objs (setq obj-lst (cons obj obj-lst)))
  (reverse obj-lst)
)

(defun getblock_name-yf        (str var)
  (princ str)
  (if (and (/= var nil) (/= var ""))
    (progn (princ "<") (princ var) (princ ">"))
  )
  (princ ":")
  (if (setq in (entsel ""))
    (setq var (cdr (assoc 2 (entget (car in)))))
    (eval var)
  )
)


;;;获取打印文件存储位置
(defun qf_getfolder (msg / winshell shfolder path catchit)
  (vl-load-com)
  (setq winshell (vlax-create-object "Shell.Application"))
  (setq shfolder (vlax-invoke-method winshell 'browseforfolder 0 msg 1))
  (setq
    catchit (vl-catch-all-apply
              '(lambda ()
                 (setq shfolder (vlax-get-property shfolder 'self))
                 (setq path (vlax-get-property shfolder 'path))
               )
            )
  )
  (if (vl-catch-all-error-p catchit)
    nil
    path
  )
)

;;;边界函数AX:GETBOUNDINGBOX (ENT)
(defun ax:getboundingbox2 (obj)
  (vla-getboundingbox obj 'll 'ur)
  (mapcar 'vlax-safearray->list (list ll ur))
)

(defun dwj-plot
                (path doc layout plotcfg drawingframe-blkname)
;;;根据图框块名过滤出某个布局中的图框
  (setq drawingframe_lst nil)
  (vlax-for block (vla-get-block layout)
    (if        (and (= (vla-get-objectname block) "AcDbBlockReference")
             (= (vla-get-name block) drawingframe-blkname)
        )
      (setq drawingframe_lst (cons block drawingframe_lst))
    )
  )

  (setq llurs nil)
  (foreach obj drawingframe_lst
    (setq llur (ax:getboundingbox2 obj))
    (setq ll (reverse (cdr (reverse (car llur)))))
    (setq ur (reverse (cdr (reverse (cadr llur)))))
;;;    获取属性变量
    (setq var (vla-getattributes obj))
;;;    属性变量转为属性表
    (setq attr-lst (vlax-safearray->list (vlax-variant-value var)))
;;;    根据属性标签，寻找属性文字
    (foreach attr attr-lst
      (setq tagstring (vla-get-tagstring attr))
      (cond
        ((= tagstring "图号")
         (setq tuhao (vla-get-textstring attr))
        )
        ((= tagstring "图纸名称")
         (setq tuming (vla-get-textstring attr))
        )
        ((= tagstring "图纸名称1")
         (setq tuming1 (vla-get-textstring attr))
        )
        (t t)
      )
    )
    (setq filename (strcat tuhao "_" tuming tuming1))
    (setq llur (list ll ur filename))
    (setq llurs (cons llur llurs))
  )

  (setq llurs (sxzy llurs 10))

  (foreach x llurs
    (setq ll (car x))
    (setq ur (cadr x))
    (setq filename (last x))
;;;设置打印范围
    (vla-setwindowtoplot
      plotcfg
      (ax:2dpoint ll)
      (ax:2dpoint ur)
    )
;;;指定页面设置为当前
    (vla-copyfrom layout plotcfg)
;;;获取当前页面设置
    (setq plot (vla-get-plot doc))
;;;打印
    (vla-plottofile
      plot
      (strcat path "\\" filename)
    )
  )
)


(defun c:mp ()
  (vl-load-com)
  (load "_lib-yf.lsp")
  (princ
    "\nmp-批量打印-多文件,预设页面设置，打开的文件都将被打印"
  )
  (setq old (getvar "OSMODE"))
  (setvar "OSMODE" 0)
;;;cad  
  (setq app (vlax-get-acad-object))
;;;文档
  (setq docs (vla-get-documents app))
;;;当前文档
  (setq *doc* (vla-get-activedocument app))
;;;当前布局  
;;;  (setq *lay* (vla-get-activelayout *doc*))
;;;页面设置
  (setq *plotcfgs* (vla-get-plotconfigurations *doc*))
  (setq tmp2 (nth 2 (objs-lst *plotcfgs*)))
;;;页面设置名表
  (setq pagesetup_name-lst nil)
  (vlax-for *plotcfg* *plotcfgs*
    (setq pagesetup_name (vla-get-name *plotcfg*))
    (setq modeltype (vla-get-modeltype *plotcfg*))
    (setq pagesetup_name-lst (cons pagesetup_name pagesetup_name-lst))
  )
  (setq pagesetup_name-lst (reverse pagesetup_name-lst))
  (setq index 1)
  (setq tmp nil)
  (foreach x pagesetup_name-lst
    (setq tmp (cons (itoa index) tmp))
    (setq tmp (cons "->" tmp))
    (setq tmp (cons x tmp))
    (setq tmp (cons ";" tmp))
    (setq index (+ 1 index))
  )
  (setq tmp (reverse tmp))
  (setq string (apply 'strcat tmp))
  (setq string (strcat "\n选择页面设置名称<" string ">"))
  (setq index2 (getint-yf string index2))
;;;页面设置名称
  (setq pagesetup_name (nth (- index2 1) pagesetup_name-lst))
;;;页面设置，用户要用的
  (setq *plotcfg* (vla-item *plotcfgs* pagesetup_name))

  (setq *windowtitle* (vla-get-windowtitle *doc*))
  (vlax-for doc        docs
;;;;;;当前文档的页面设置复制到其他文档
    (if        (/= (strcase (vla-get-windowtitle doc))
            (strcase *windowtitle*)
        )
      (progn
;;;        在其他文档创建页面设置名为pagesetup_name的页面设置
        (setq plotcfg (vla-add
                        (vla-get-plotconfigurations doc)
                        pagesetup_name
                        :vlax-false
                      )
        )
;;;将*plotcfg*复制进plotcfg
        (vla-copyfrom plotcfg *plotcfg*)
        (vlax-for layout (vla-get-layouts doc)
          (if (/= (vla-get-name layout) "Model")
            (vla-copyfrom
              layout
              plotcfg
            )
          )
        )
      )
    )
  )

  (setq        drawingframe-blkname
         (getblock_name-yf
           "\n选择图框,获取图框块名"
           drawingframe-blkname
         )
  )
  (princ drawingframe-blkname)

  (setq path (qf_getfolder "选择打印文件保存位置"))

  (vlax-for doc        docs
    (setq doc doc)
    (setq plotcfgs (vla-get-plotconfigurations doc))
    (setq plotcfg (vla-item plotcfgs pagesetup_name))
;;;    (vla-put-activedocument app doc)
;;;    (vla-activate doc)
    (vlax-for layout (vla-get-layouts doc)
      (setq name (vla-get-name layout))
      (if (/= name "Model")
        (dwj-plot path doc layout plotcfg drawingframe-blkname)
      )
    )
  )

;;;  (setq docs (vla-get-documents (vlax-get-acad-object)))  
;;;  (setq doc (vla-item docs 0))
;;;  (setq plotcfgs (vla-get-plotconfigurations doc))
;;;  (setq plotcfg (vla-item plotcfgs "yf-dwg to pdf-A2"))
;;;  (setq layout (vla-get-activelayout doc))  
;;;  (dwj-plot path doc layout plotcfg drawingframe-blkname)

  (princ)
)