简易的多文件批量打印，程序只能打印当前的dwg文件，求网友查错。
简易的多文件批量打印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 docdocs
;;;;;;当前文档的页面设置复制到其他文档
(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
)
)
)
)
)
)
(setqdrawingframe-blkname
(getblock_name-yf
"\n选择图框,获取图框块名"
drawingframe-blkname
)
)
(princ drawingframe-blkname)
(setq path (qf_getfolder "选择打印文件保存位置"))
(vlax-for docdocs
(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)
)
大佬，提示有个啥没得 zj20190405 发表于 2020-8-30 12:20
大佬，提示有个啥没得
需要大佬纠错 论坛有其他打印程序 http://bbs.mjtd.com/thread-110079-1-1.html
这是我的一个文件夹下的多文件打印。
lisp中好象不能激活其它文件。 nxchenjk 发表于 2020-8-31 08:49
http://bbs.mjtd.com/thread-110079-1-1.html
这是我的一个文件夹下的多文件打印。
lisp中好象不能激活其 ...
您用的是命令行模式，我想用vla模式 zj20190405 发表于 2020-8-30 12:20
大佬，提示有个啥没得
您是说您那里可以正常打印? 本帖最后由 陈伟 于 2021-9-23 15:57 编辑
批打成功了没有？？lib-yf.lsp文件没有，都无法测试
页:
[1]