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

my0314cn

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

2. (defun ax:2dpoint (pt)
   
3.   (vlax-make-variant
   
4.     (vlax-safearray-fill
   
5.       (vlax-make-safearray vlax-vbdouble '(0 . 1))
   
6.       (list (car pt) (cadr pt))
   
7.     )
   
8.   )
   
9. )
   
10. 
    
11. (defun objs-lst  (objs)
    
12.   (setq obj-lst nil)
    
13.   (vlax-for obj objs (setq obj-lst (cons obj obj-lst)))
    
14.   (reverse obj-lst)
    
15. )
    
16. 
    
17. (defun getblock_name-yf  (str var)
    
18.   (princ str)
    
19.   (if (and (/= var nil) (/= var ""))
    
20.     (progn (princ "<") (princ var) (princ ">"))
    
21.   )
    
22.   (princ ":")
    
23.   (if (setq in (entsel ""))
    
24.     (setq var (cdr (assoc 2 (entget (car in)))))
    
25.     (eval var)
    
26.   )
    
27. )
    
28. 
    
29. 
    
30. ;;;获取打印文件存储位置
    
31. (defun qf_getfolder (msg / winshell shfolder path catchit)
    
32.   (vl-load-com)
    
33.   (setq winshell (vlax-create-object "Shell.Application"))
    
34.   (setq shfolder (vlax-invoke-method winshell 'browseforfolder 0 msg 1))
    
35.   (setq
    
36.     catchit (vl-catch-all-apply
    
37.         '(lambda ()
    
38.      (setq shfolder (vlax-get-property shfolder 'self))
    
39.      (setq path (vlax-get-property shfolder 'path))
    
40.          )
    
41.       )
    
42.   )
    
43.   (if (vl-catch-all-error-p catchit)
    
44.     nil
    
45.     path
    
46.   )
    
47. )
    
48. 
    
49. ;;;边界函数AX:GETBOUNDINGBOX (ENT)
    
50. (defun ax:getboundingbox2 (obj)
    
51.   (vla-getboundingbox obj 'll 'ur)
    
52.   (mapcar 'vlax-safearray->list (list ll ur))
    
53. )
    
54. 
    
55. (defun dwj-plot
    
56.     (path doc layout plotcfg drawingframe-blkname)
    
57. ;;;根据图框块名过滤出某个布局中的图框
    
58.   (setq drawingframe_lst nil)
    
59.   (vlax-for block (vla-get-block layout)
    
60.     (if  (and (= (vla-get-objectname block) "AcDbBlockReference")
    
61.        (= (vla-get-name block) drawingframe-blkname)
    
62.   )
    
63.       (setq drawingframe_lst (cons block drawingframe_lst))
    
64.     )
    
65.   )
    
66. 
    
67.   (setq llurs nil)
    
68.   (foreach obj drawingframe_lst
    
69.     (setq llur (ax:getboundingbox2 obj))
    
70.     (setq ll (reverse (cdr (reverse (car llur)))))
    
71.     (setq ur (reverse (cdr (reverse (cadr llur)))))
    
72. ;;;    获取属性变量
    
73.     (setq var (vla-getattributes obj))
    
74. ;;;    属性变量转为属性表
    
75.     (setq attr-lst (vlax-safearray->list (vlax-variant-value var)))
    
76. ;;;    根据属性标签，寻找属性文字
    
77.     (foreach attr attr-lst
    
78.       (setq tagstring (vla-get-tagstring attr))
    
79.       (cond
    
80.   ((= tagstring "图号")
    
81.    (setq tuhao (vla-get-textstring attr))
    
82.   )
    
83.   ((= tagstring "图纸名称")
    
84.    (setq tuming (vla-get-textstring attr))
    
85.   )
    
86.   ((= tagstring "图纸名称1")
    
87.    (setq tuming1 (vla-get-textstring attr))
    
88.   )
    
89.   (t t)
    
90.       )
    
91.     )
    
92.     (setq filename (strcat tuhao "_" tuming tuming1))
    
93.     (setq llur (list ll ur filename))
    
94.     (setq llurs (cons llur llurs))
    
95.   )
    
96. 
    
97.   (setq llurs (sxzy llurs 10))
    
98. 
    
99.   (foreach x llurs
    
100.     (setq ll (car x))
     
101.     (setq ur (cadr x))
     
102.     (setq filename (last x))
     
103. ;;;设置打印范围
     
104.     (vla-setwindowtoplot
     
105.       plotcfg
     
106.       (ax:2dpoint ll)
     
107.       (ax:2dpoint ur)
     
108.     )
     
109. ;;;指定页面设置为当前
     
110.     (vla-copyfrom layout plotcfg)
     
111. ;;;获取当前页面设置
     
112.     (setq plot (vla-get-plot doc))
     
113. ;;;打印
     
114.     (vla-plottofile
     
115.       plot
     
116.       (strcat path "\" filename)
     
117.     )
     
118.   )
     
119. )
     
120. 
     
121. 
     
122. (defun c:mp ()
     
123.   (vl-load-com)
     
124.   (load "_lib-yf.lsp")
     
125.   (princ
     
126.     "\nmp-批量打印-多文件,预设页面设置，打开的文件都将被打印"
     
127.   )
     
128.   (setq old (getvar "OSMODE"))
     
129.   (setvar "OSMODE" 0)
     
130. ;;;cad  
     
131.   (setq app (vlax-get-acad-object))
     
132. ;;;文档
     
133.   (setq docs (vla-get-documents app))
     
134. ;;;当前文档
     
135.   (setq *doc* (vla-get-activedocument app))
     
136. ;;;当前布局  
     
137. ;;;  (setq *lay* (vla-get-activelayout *doc*))
     
138. ;;;页面设置
     
139.   (setq *plotcfgs* (vla-get-plotconfigurations *doc*))
     
140.   (setq tmp2 (nth 2 (objs-lst *plotcfgs*)))
     
141. ;;;页面设置名表
     
142.   (setq pagesetup_name-lst nil)
     
143.   (vlax-for *plotcfg* *plotcfgs*
     
144.     (setq pagesetup_name (vla-get-name *plotcfg*))
     
145.     (setq modeltype (vla-get-modeltype *plotcfg*))
     
146.     (setq pagesetup_name-lst (cons pagesetup_name pagesetup_name-lst))
     
147.   )
     
148.   (setq pagesetup_name-lst (reverse pagesetup_name-lst))
     
149.   (setq index 1)
     
150.   (setq tmp nil)
     
151.   (foreach x pagesetup_name-lst
     
152.     (setq tmp (cons (itoa index) tmp))
     
153.     (setq tmp (cons "->" tmp))
     
154.     (setq tmp (cons x tmp))
     
155.     (setq tmp (cons ";" tmp))
     
156.     (setq index (+ 1 index))
     
157.   )
     
158.   (setq tmp (reverse tmp))
     
159.   (setq string (apply 'strcat tmp))
     
160.   (setq string (strcat "\n选择页面设置名称<" string ">"))
     
161.   (setq index2 (getint-yf string index2))
     
162. ;;;页面设置名称
     
163.   (setq pagesetup_name (nth (- index2 1) pagesetup_name-lst))
     
164. ;;;页面设置，用户要用的
     
165.   (setq *plotcfg* (vla-item *plotcfgs* pagesetup_name))
     
166. 
     
167.   (setq *windowtitle* (vla-get-windowtitle *doc*))
     
168.   (vlax-for doc  docs
     
169. ;;;;;;当前文档的页面设置复制到其他文档
     
170.     (if  (/= (strcase (vla-get-windowtitle doc))
     
171.       (strcase *windowtitle*)
     
172.   )
     
173.       (progn
     
174. ;;;  在其他文档创建页面设置名为pagesetup_name的页面设置
     
175.   (setq plotcfg (vla-add
     
176.       (vla-get-plotconfigurations doc)
     
177.       pagesetup_name
     
178.       :vlax-false
     
179.           )
     
180.   )
     
181. ;;;将*plotcfg*复制进plotcfg
     
182.   (vla-copyfrom plotcfg *plotcfg*)
     
183.   (vlax-for layout (vla-get-layouts doc)
     
184.     (if (/= (vla-get-name layout) "Model")
     
185.       (vla-copyfrom
     
186.         layout
     
187.         plotcfg
     
188.       )
     
189.     )
     
190.   )
     
191.       )
     
192.     )
     
193.   )
     
194. 
     
195.   (setq  drawingframe-blkname
     
196.    (getblock_name-yf
     
197.      "\n选择图框,获取图框块名"
     
198.      drawingframe-blkname
     
199.    )
     
200.   )
     
201.   (princ drawingframe-blkname)
     
202. 
     
203.   (setq path (qf_getfolder "选择打印文件保存位置"))
     
204. 
     
205.   (vlax-for doc  docs
     
206.     (setq doc doc)
     
207.     (setq plotcfgs (vla-get-plotconfigurations doc))
     
208.     (setq plotcfg (vla-item plotcfgs pagesetup_name))
     
209. ;;;    (vla-put-activedocument app doc)
     
210. ;;;    (vla-activate doc)
     
211.     (vlax-for layout (vla-get-layouts doc)
     
212.       (setq name (vla-get-name layout))
     
213.       (if (/= name "Model")
     
214.   (dwj-plot path doc layout plotcfg drawingframe-blkname)
     
215.       )
     
216.     )
     
217.   )
     
218. 
     
219. ;;;  (setq docs (vla-get-documents (vlax-get-acad-object)))  
     
220. ;;;  (setq doc (vla-item docs 0))
     
221. ;;;  (setq plotcfgs (vla-get-plotconfigurations doc))
     
222. ;;;  (setq plotcfg (vla-item plotcfgs "yf-dwg to pdf-A2"))
     
223. ;;;  (setq layout (vla-get-activelayout doc))  
     
224. ;;;  (dwj-plot path doc layout plotcfg drawingframe-blkname)
     
225. 
     
226.   (princ)
     
227. )
     
228. 
     
229. 
     

(defun ax:2dpoint (pt)<br />   (vlax-make-variant<br />     (vlax-safearray-fill<br />       (vlax-make-safearray vlax-vbdouble '(0 . 1))<br />       (list (car pt) (cadr pt))<br />     )<br />   )<br /> )<br /> <br /> (defun objs-lst  (objs)<br />   (setq obj-lst nil)<br />   (vlax-for obj objs (setq obj-lst (cons obj obj-lst)))<br />   (reverse obj-lst)<br /> )<br /> <br /> (defun getblock_name-yf  (str var)<br />   (princ str)<br />   (if (and (/= var nil) (/= var ""))<br />     (progn (princ "<") (princ var) (princ ">"))<br />   )<br />   (princ ":")<br />   (if (setq in (entsel ""))<br />     (setq var (cdr (assoc 2 (entget (car in)))))<br />     (eval var)<br />   )<br /> )<br /> <br /> <br /> ;;;获取打印文件存储位置<br /> (defun qf_getfolder (msg / winshell shfolder path catchit)<br />   (vl-load-com)<br />   (setq winshell (vlax-create-object "Shell.Application"))<br />   (setq shfolder (vlax-invoke-method winshell 'browseforfolder 0 msg 1))<br />   (setq<br />     catchit (vl-catch-all-apply<br />         '(lambda ()<br />      (setq shfolder (vlax-get-property shfolder 'self))<br />      (setq path (vlax-get-property shfolder 'path))<br />          )<br />       )<br />   )<br />   (if (vl-catch-all-error-p catchit)<br />     nil<br />     path<br />   )<br /> )<br /> <br /> ;;;边界函数AX:GETBOUNDINGBOX (ENT)<br /> (defun ax:getboundingbox2 (obj)<br />   (vla-getboundingbox obj 'll 'ur)<br />   (mapcar 'vlax-safearray->list (list ll ur))<br /> )<br /> <br /> (defun dwj-plot<br />     (path doc layout plotcfg drawingframe-blkname)<br /> ;;;根据图框块名过滤出某个布局中的图框<br />   (setq drawingframe_lst nil)<br />   (vlax-for block (vla-get-block layout)<br />     (if  (and (= (vla-get-objectname block) "AcDbBlockReference")<br />        (= (vla-get-name block) drawingframe-blkname)<br />   )<br />       (setq drawingframe_lst (cons block drawingframe_lst))<br />     )<br />   )<br /> <br />   (setq llurs nil)<br />   (foreach obj drawingframe_lst<br />     (setq llur (ax:getboundingbox2 obj))<br />     (setq ll (reverse (cdr (reverse (car llur)))))<br />     (setq ur (reverse (cdr (reverse (cadr llur)))))<br /> ;;;    获取属性变量<br />     (setq var (vla-getattributes obj))<br /> ;;;    属性变量转为属性表<br />     (setq attr-lst (vlax-safearray->list (vlax-variant-value var)))<br /> ;;;    根据属性标签，寻找属性文字<br />     (foreach attr attr-lst<br />       (setq tagstring (vla-get-tagstring attr))<br />       (cond<br />   ((= tagstring "图号")<br />    (setq tuhao (vla-get-textstring attr))<br />   )<br />   ((= tagstring "图纸名称")<br />    (setq tuming (vla-get-textstring attr))<br />   )<br />   ((= tagstring "图纸名称1")<br />    (setq tuming1 (vla-get-textstring attr))<br />   )<br />   (t t)<br />       )<br />     )<br />     (setq filename (strcat tuhao "_" tuming tuming1))<br />     (setq llur (list ll ur filename))<br />     (setq llurs (cons llur llurs))<br />   )<br /> <br />   (setq llurs (sxzy llurs 10))<br /> <br />   (foreach x llurs<br />     (setq ll (car x))<br />     (setq ur (cadr x))<br />     (setq filename (last x))<br /> ;;;设置打印范围<br />     (vla-setwindowtoplot<br />       plotcfg<br />       (ax:2dpoint ll)<br />       (ax:2dpoint ur)<br />     )<br /> ;;;指定页面设置为当前<br />     (vla-copyfrom layout plotcfg)<br /> ;;;获取当前页面设置<br />     (setq plot (vla-get-plot doc))<br /> ;;;打印<br />     (vla-plottofile<br />       plot<br />       (strcat path "\" filename)<br />     )<br />   )<br /> )<br /> <br /> <br /> (defun c:mp ()<br />   (vl-load-com)<br />   (load "_lib-yf.lsp")<br />   (princ<br />     "\nmp-批量打印-多文件,预设页面设置，打开的文件都将被打印"<br />   )<br />   (setq old (getvar "OSMODE"))<br />   (setvar "OSMODE" 0)<br /> ;;;cad  <br />   (setq app (vlax-get-acad-object))<br /> ;;;文档<br />   (setq docs (vla-get-documents app))<br /> ;;;当前文档<br />   (setq *doc* (vla-get-activedocument app))<br /> ;;;当前布局  <br /> ;;;  (setq *lay* (vla-get-activelayout *doc*))<br /> ;;;页面设置<br />   (setq *plotcfgs* (vla-get-plotconfigurations *doc*))<br />   (setq tmp2 (nth 2 (objs-lst *plotcfgs*)))<br /> ;;;页面设置名表<br />   (setq pagesetup_name-lst nil)<br />   (vlax-for *plotcfg* *plotcfgs*<br />     (setq pagesetup_name (vla-get-name *plotcfg*))<br />     (setq modeltype (vla-get-modeltype *plotcfg*))<br />     (setq pagesetup_name-lst (cons pagesetup_name pagesetup_name-lst))<br />   )<br />   (setq pagesetup_name-lst (reverse pagesetup_name-lst))<br />   (setq index 1)<br />   (setq tmp nil)<br />   (foreach x pagesetup_name-lst<br />     (setq tmp (cons (itoa index) tmp))<br />     (setq tmp (cons "->" tmp))<br />     (setq tmp (cons x tmp))<br />     (setq tmp (cons ";" tmp))<br />     (setq index (+ 1 index))<br />   )<br />   (setq tmp (reverse tmp))<br />   (setq string (apply 'strcat tmp))<br />   (setq string (strcat "\n选择页面设置名称<" string ">"))<br />   (setq index2 (getint-yf string index2))<br /> ;;;页面设置名称<br />   (setq pagesetup_name (nth (- index2 1) pagesetup_name-lst))<br /> ;;;页面设置，用户要用的<br />   (setq *plotcfg* (vla-item *plotcfgs* pagesetup_name))<br /> <br />   (setq *windowtitle* (vla-get-windowtitle *doc*))<br />   (vlax-for doc  docs<br /> ;;;;;;当前文档的页面设置复制到其他文档<br />     (if  (/= (strcase (vla-get-windowtitle doc))<br />       (strcase *windowtitle*)<br />   )<br />       (progn<br /> ;;;  在其他文档创建页面设置名为pagesetup_name的页面设置<br />   (setq plotcfg (vla-add<br />       (vla-get-plotconfigurations doc)<br />       pagesetup_name<br />       :vlax-false<br />           )<br />   )<br /> ;;;将*plotcfg*复制进plotcfg<br />   (vla-copyfrom plotcfg *plotcfg*)<br />   (vlax-for layout (vla-get-layouts doc)<br />     (if (/= (vla-get-name layout) "Model")<br />       (vla-copyfrom<br />         layout<br />         plotcfg<br />       )<br />     )<br />   )<br />       )<br />     )<br />   )<br /> <br />   (setq  drawingframe-blkname<br />    (getblock_name-yf<br />      "\n选择图框,获取图框块名"<br />      drawingframe-blkname<br />    )<br />   )<br />   (princ drawingframe-blkname)<br /> <br />   (setq path (qf_getfolder "选择打印文件保存位置"))<br /> <br />   (vlax-for doc  docs<br />     (setq doc doc)<br />     (setq plotcfgs (vla-get-plotconfigurations doc))<br />     (setq plotcfg (vla-item plotcfgs pagesetup_name))<br /> ;;;    (vla-put-activedocument app doc)<br /> ;;;    (vla-activate doc)<br />     (vlax-for layout (vla-get-layouts doc)<br />       (setq name (vla-get-name layout))<br />       (if (/= name "Model")<br />   (dwj-plot path doc layout plotcfg drawingframe-blkname)<br />       )<br />     )<br />   )<br /> <br /> ;;;  (setq docs (vla-get-documents (vlax-get-acad-object)))  <br /> ;;;  (setq doc (vla-item docs 0))<br /> ;;;  (setq plotcfgs (vla-get-plotconfigurations doc))<br /> ;;;  (setq plotcfg (vla-item plotcfgs "yf-dwg to pdf-A2"))<br /> ;;;  (setq layout (vla-get-activelayout doc))  <br /> ;;;  (dwj-plot path doc layout plotcfg drawingframe-blkname)<br /> <br />   (princ)<br /> )<br /> <br /> <br />

zj20190405

大佬，提示有个啥没得

my0314cn

zj20190405 发表于 2020-8-30 12:20
大佬，提示有个啥没得

需要大佬纠错

zj20190405

论坛有其他打印程序

nxchenjk

http://bbs.mjtd.com/thread-110079-1-1.html
这是我的一个文件夹下的多文件打印。
lisp中好象不能激活其它文件。

my0314cn

nxchenjk 发表于 2020-8-31 08:49
http://bbs.mjtd.com/thread-110079-1-1.html
这是我的一个文件夹下的多文件打印。
lisp中好象不能激活其 ...

您用的是命令行模式，我想用vla模式

my0314cn

zj20190405 发表于 2020-8-30 12:20
大佬，提示有个啥没得

您是说您那里可以正常打印?

陈伟

批打成功了没有？？lib-yf.lsp  文件没有，都无法测试