如何用lisp分别保存多个打印设置为打印页面设置

xiaoyingzi

2. ;修改多图档的打印配置示例 By carrot1983 12/1/09
   
3. ;xiaoyingzi 修改
   
4. 
   
5. (defun ChangePlotConfig (configName styleSheet papersize PlotRotation Plotscale / acApp acDocs layouts)
   
6.   (vl-load-com)
   
7.   (setq acApp (vlax-get-acad-object))
   
8.   (setq acDocs (vla-get-documents acApp))
   
9.   (vlax-for doc acDocs
   
10.     (setq layouts (vla-get-layouts doc))
    
11.     (vlax-for layout layouts
    
12.       (vla-put-configname layout configName)           ;打印机
    
13.       (vla-put-stylesheet layout styleSheet)           ;打印样式
    
14.       (vla-put-CanonicalMediaName layout papersize)    ;图纸尺寸
    
15.       (if (= "纵向" PlotRotation)
    
16.           (vla-put-PlotRotation layout ac0Degrees)     ;图形方向  纵向
    
17.           (vla-put-PlotRotation layout ac90Degrees)    ;图形方向  横向
    
18.       )
    
19.       (if (= "按图纸空间缩放" Plotscale)
    
20.           (vla-put-standardscale layout acScaleToFit)  ;比例      按图纸空间缩放
    
21.           (vla-put-standardscale layout ac1_100)       ;比例      1:100
    
22.       )
    
23.       (vla-put-paperunits layout acMillimeters)        ;单位      米
    
24.     )
    
25.   )
    
26. )
    
27. 
    
28. 
    
29. (defun c:a1 ()
    
30.   (ChangePlotConfig "\\\\夏秀兰\\HP DesignJet 430" "蜡纸.ctb" "A3" "过大尺寸：ISO A1  (纵向)" "纵向" "1:100" )
    
31.   (princ "\n当前打印机Generic 16BW-5,纸张A4,白纸,横向进纸,按图纸空间缩放打印! ")
    
32.   (princ)
    
33. )
    
34. 
    
35. (defun c:a2 ()
    
36.   (ChangePlotConfig "\\\\夏秀兰\\HP DesignJet 430" "蜡纸.ctb" "A4" "过大尺寸：ISO A1  (横向)" "横向" "1:100" )
    
37.   (princ "\n当前打印机Generic 16BW-5,纸张A4,白纸,横向进纸,按图纸空间缩放打印! ")
    
38.   (princ)
    
39. )
    
40. 
    
41. 
    
42. (defun c:a3 ()
    
43.   (ChangePlotConfig "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "A3" "纵向" "按图纸空间缩放" )
    
44.   (princ "\n当前打印机Generic 16BW-5,纸张A4,白纸,横向进纸,按图纸空间缩放打印! ")
    
45.   (princ)
    
46. )
    
47. 
    
48. (defun c:a4 ()
    
49.   (ChangePlotConfig "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "A4" "横向" "按图纸空间缩放" )
    
50.   (princ "\n当前打印机Generic 16BW-5,纸张A4,白纸,横向进纸,按图纸空间缩放打印! ")
    
51.   (princ)
    
52. )
    

;修改多图档的打印配置示例 By carrot1983 12/1/09<br /> ;xiaoyingzi 修改<br /> <br /> (defun ChangePlotConfig (configName styleSheet papersize PlotRotation Plotscale / acApp acDocs layouts)<br />   (vl-load-com)<br />   (setq acApp (vlax-get-acad-object))<br />   (setq acDocs (vla-get-documents acApp))<br />   (vlax-for doc acDocs<br />     (setq layouts (vla-get-layouts doc))<br />     (vlax-for layout layouts<br />       (vla-put-configname layout configName)           ;打印机<br />       (vla-put-stylesheet layout styleSheet)           ;打印样式<br />       (vla-put-CanonicalMediaName layout papersize)    ;图纸尺寸<br />       (if (= "纵向" PlotRotation)<br />           (vla-put-PlotRotation layout ac0Degrees)     ;图形方向  纵向<br />           (vla-put-PlotRotation layout ac90Degrees)    ;图形方向  横向<br />       )<br />       (if (= "按图纸空间缩放" Plotscale)<br />           (vla-put-standardscale layout acScaleToFit)  ;比例      按图纸空间缩放<br />           (vla-put-standardscale layout ac1_100)       ;比例      1:100<br />       )<br />       (vla-put-paperunits layout acMillimeters)        ;单位      米<br />     )<br />   )<br /> )<br /> <br /> <br /> (defun c:a1 ()<br />   (ChangePlotConfig "\\\\夏秀兰\\HP DesignJet 430" "蜡纸.ctb" "A3" "过大尺寸：ISO A1  (纵向)" "纵向" "1:100" )<br />   (princ "\n当前打印机Generic 16BW-5,纸张A4,白纸,横向进纸,按图纸空间缩放打印! ")<br />   (princ)<br /> )<br /> <br /> (defun c:a2 ()<br />   (ChangePlotConfig "\\\\夏秀兰\\HP DesignJet 430" "蜡纸.ctb" "A4" "过大尺寸：ISO A1  (横向)" "横向" "1:100" )<br />   (princ "\n当前打印机Generic 16BW-5,纸张A4,白纸,横向进纸,按图纸空间缩放打印! ")<br />   (princ)<br /> )<br /> <br /> <br /> (defun c:a3 ()<br />   (ChangePlotConfig "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "A3" "纵向" "按图纸空间缩放" )<br />   (princ "\n当前打印机Generic 16BW-5,纸张A4,白纸,横向进纸,按图纸空间缩放打印! ")<br />   (princ)<br /> )<br /> <br /> (defun c:a4 ()<br />   (ChangePlotConfig "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "A4" "横向" "按图纸空间缩放" )<br />   (princ "\n当前打印机Generic 16BW-5,纸张A4,白纸,横向进纸,按图纸空间缩放打印! ")<br />   (princ)<br /> )<br />

如上代码，完成了以上4种设置后，如何用lisp实现分别保存这四种设置为四种页面设置，页面设置名默认设置为A1(白纸）、A2(白纸）、A3(蜡纸）、A4(蜡纸）
如果能实现，接下来再用秋枫的批量打印就很爽了

tanle2020

怎么增加自定义图纸尺寸的设定，比如一些加长图纸

my0314cn

简易的多文件批量打印 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) )

xiaoyingzi

更新下两个：以前只能获取打印机，不能获取pc3的打印设备，现在可以了

;;; 取得系统默认打印机GetActivePlotDevice
(defun getcurrentprinter ( / app docs)
  (setq app (vlax-get-acad-object))
  (setq docs (vla-get-activedocument app))
  (vla-get-ConfigName
  (vla-get-ActiveLayout docs))
)

;;; 取得系统全部打印设备GetPlotDevices，包括pc3设备
(defun getallprinters ( / app docs)
  (setq app (vlax-get-acad-object))
  (setq docs (vla-get-activedocument app))
  (vla-RefreshPlotDeviceInfo (vla-get-activelayout docs))
  (vlax-safearray->list
    (vlax-variant-value
      (vla-getplotdevicenames
        (vla-item (vla-get-layouts docs) "Model")
       )
     )
   )
)

xiaoyingzi

花了不少时间，终于自己解决了，最后配上秋枫的批量打印，自己用得很方便了

1. ;;;xiaoyingzi 2011.08.21
   
2. 
   
3. ;;; 修改当前图档的打印配置
   
4. (defun ChangePlotConfig (configName styleSheet PlotRotation PaperSize Plotscale CenterPlot / app doc layout newOrigin)
   
5.   (vl-load-com)
   
6.   (setq app (vlax-get-acad-object)
   
7.         doc (vla-get-activedocument app)
   
8.         layout (vla-get-activelayout doc)
   
9.   )
   
10.   (vla-RefreshPlotDeviceInfo layout)
    
11.   (vla-put-configname layout configName)           ;打印机
    
12.   (vla-put-stylesheet layout styleSheet)           ;打印样式
    
13. 
    
14.   (if (= "纵向" PlotRotation)
    
15.       (vla-put-PlotRotation layout ac0Degrees)     ;图形方向  纵向
    
16.       (vla-put-PlotRotation layout ac90Degrees)    ;图形方向  横向
    
17.   )
    
18. 
    
19.   (setq index                                      ;开始修改纸张
    
20.        (vl-position (strcase PaperSize)
    
21.                     (mapcar (function strcase)
    
22.                             (GetPaperList1 configName)
    
23.                     )
    
24.       )
    
25.   )
    
26.   (vla-put-CanonicalMediaName layout (nth index (GetPaperList2 configName)))
    
27.   (princ)
    
28. 
    
29.   (if (= "按图纸空间缩放" Plotscale)               ;比例      按图纸空间缩放
    
30.       (vla-put-standardscale layout acScaleToFit)
    
31.       (progn
    
32.       (vla-put-standardscale layout acVpCustomScale)
    
33.       (vla-SetCustomScale layout 1 Plotscale)      ;比例      自定义比例1:Plotscale
    
34.       )
    
35.   )
    
36. 
    
37.   (if (= "居中打印" CenterPlot)
    
38.       (vla-put-CenterPlot layout :vlax-true)       ;居中打印
    
39.       (progn
    
40.       (vla-put-CenterPlot layout :vlax-false)      ;不居中打印
    
41.       (setq newOrigin (vlax-make-safearray vlax-vbDouble '(0 . 1)))
    
42.       (vlax-safearray-fill newOrigin (list 0 0))   ;设定打印偏移x为0，y为0
    
43.       (vla-put-PlotOrigin Layout newOrigin)
    
44.       )
    
45.   )
    
46.   ;(vla-SetWindowToPlot layout newOrigin newOrigin)
    
47.   ;(vla-put-PlotType layout acWindow)               ;打印范围  窗口
    
48. 
    
49.   (vla-put-paperunits layout acMillimeters)        ;单位      米
    
50.   (vla-put-PlotWithLineweights layout :vlax-true)  ;true: 使用打印型式中的线宽来打印 false: 使用图形文件中的线宽来打印
    
51. )
    
52. 
    
53. ;;; 获得某打印机纸张类型列表, 返回形如 "过大尺寸：ISO A2  (纵向)" "过大尺寸：ISO A2  (横向)".... 的列表
    
54. ;;; 例:  (setq PaperSizes (GetPaperList1 "HP DesignJet 430 (E/A0) by HP" ))
    
55. (defun GetPaperList1 (configName / app canpapersizearr canpapersizelist canpapersizevar app doc index layout papersize)
    
56.   (vl-load-com)
    
57.   (setq app (vlax-get-acad-object)
    
58.         doc (vla-get-activedocument app)
    
59.         layout (vla-get-activelayout doc)
    
60.   )
    
61.   (vla-put-configname layout configName)  ;将打印机设为当前打印机
    
62.   (vla-RefreshPlotDeviceInfo layout)
    
63.   (setq CanPaperSizeVar (vla-GetCanonicalMediaNames layout)
    
64.         CanPaperSizeArr (vlax-variant-value CanPaperSizeVar)
    
65.         CanPaperSizeLIst (vlax-safearray->list CanPaperSizeArr)
    
66.         PaperSize '()
    
67.         index 0
    
68.   )
    
69.   (repeat (length CanPaperSizeList)
    
70.           (setq Papersize (cons (vla-GetLocaleMediaName layout (nth index CanPaperSizeList)) Papersize)
    
71.                 index (1+ index)
    
72.           )
    
73.   )
    
74.   (reverse PaperSize)
    
75. )
    
76. 
    
77. ;;; 获得某打印机纸张类型列表, 返回形如 "User620" "User1644".... 的列表
    
78. ;;; 例:  (setq PaperSizes (GetPaperList2 "HP DesignJet 430 (E/A0) by HP" ))
    
79. (defun GetPaperList2 (configName / app canpapersizearr canpapersizelist canpapersizevar app doc layout)
    
80.   (vl-load-com)
    
81.   (setq app (vlax-get-acad-object)
    
82.         doc (vla-get-activedocument app)
    
83.         layout (vla-get-activelayout doc)
    
84.   )
    
85.   (vla-put-configname layout configName);将打印机设为当前打印机
    
86.   (vla-RefreshPlotDeviceInfo layout)
    
87.   (setq CanPaperSizeVar (vla-GetCanonicalMediaNames (vla-item (vla-get-layouts doc) "Model"))
    
88.         CanPaperSizeArr (vlax-variant-value CanPaperSizeVar)
    
89.         CanPaperSizeLIst (vlax-safearray->list CanPaperSizeArr)
    
90.   )
    
91. )
    
92. 
    
93. ;;; 在当前布局，把当前打印设置添加到一个新的页面设置，并置为当前
    
94. ;;; (addPageSetup <PageSetupName>)
    
95. ;;; 例: (AddPageSetup ("PageSetupName")
    
96. (defun AddPageSetup (name / space pc lay PlotConfig)
    
97.   (setq app (vlax-get-acad-object)
    
98.         doc (vla-get-activedocument app)
    
99.         layout (vla-get-activelayout doc)
    
100.   )
     
101.   ; 删除已有的打印页面设置
     
102.   (vlax-for pc (vla-get-plotconfigurations doc)
     
103.     (if (= (strcase (vla-get-name pc)) (strcase name))
     
104.         (vla-delete pc)
     
105.     )
     
106.   )
     
107.   ; 添加到新的页面设置
     
108.   (if (= (getvar "ctab") "Model")
     
109.     (setq space :vlax-true
     
110.           lay (vla-get-Layout (vla-get-ModelSpace
     
111.                 (vla-get-activedocument (vlax-get-acad-object)))))
     
112.     (setq space :vlax-false
     
113.           lay (vla-get-ActiveLayout (vla-get-activedocument
     
114.                 (vlax-get-acad-object))))
     
115.   )
     
116.   (setq pc (vla-add
     
117.              (vla-get-plotconfigurations doc)
     
118.              name
     
119.              space))
     
120.   (vla-CopyFrom pc lay)
     
121.   (vla-put-name pc name)
     
122.   ; 把新添加的页面设置置为当前
     
123.   (setq PlotConfig (vl-catch-all-apply
     
124.          'vla-item
     
125.          (list
     
126.            (vla-get-PlotConfigurations
     
127.        doc
     
128.            )
     
129.            name
     
130.          )
     
131.        )
     
132.   )
     
133.   (if (not (vl-catch-all-error-p PlotConfig))
     
134.       (vla-copyfrom layout PlotConfig)
     
135.   )
     
136. (princ)
     
137. )
     
138. 
     
139. (defun c:a1 ()
     
140.   (ChangePlotConfig "\\\\hp430\\hp designJet 430 (e/a0) by hp"  "蜡纸.ctb" "纵向" "过大尺寸：ISO A1  (纵向)" 100 "不居中打印")
     
141.   (AddPageSetup "蜡纸A1")
     
142.   (princ "\n当前打印机HP DesignJet 430,蜡纸,纵向进纸,纸张A1,1:100打印比例,居中打印! ")
     
143.   (princ "\n当前打印页面设置名为蜡纸A1! ")
     
144.   (princ)
     
145. )
     
146. 
     
147. (defun c:a2 ()
     
148.   (ChangePlotConfig "\\\\hp430\\hp designJet 430 (e/a0) by hp"  "蜡纸.ctb" "横向" "过大尺寸：ISO A2  (横向)" 100 "不居中打印")
     
149.   (AddPageSetup "蜡纸A2")
     
150.   (princ "\n当前打印机HP DesignJet 430,蜡纸,纵向进纸,纸张A2,1:100打印比例,居中打印! ")
     
151.   (princ "\n当前打印页面设置名为蜡纸A2! ")
     
152.   (princ)
     
153. )
     
154. 
     
155. (defun c:a3 ()
     
156.   (ChangePlotConfig "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "纵向" "A3" "按图纸空间缩放" "居中打印")
     
157.   (AddPageSetup "白纸A3")
     
158.   (princ "\n当前打印机Generic 16BW-5,白纸,纵向进纸,纸张A3,按图纸空间缩放,居中打印! ")
     
159.   (princ "\n当前打印页面设置名为纸张A3! ")
     
160.   (princ)
     
161. )
     
162. 
     
163. (defun c:a4 ()
     
164.   (ChangePlotConfig "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "横向" "A4" "按图纸空间缩放" "居中打印")
     
165.   (AddPageSetup "白纸A4")
     
166.   (princ "\n当前打印机Generic 16BW-5,白纸,横向进纸,纸张A4,按图纸空间缩放,居中打印! ")
     
167.   (princ "\n当前打印页面设置名为纸张A4! ")
     
168.   (princ)
     
169. )

;;;xiaoyingzi 2011.08.21<br /> <br /> ;;; 修改当前图档的打印配置<br /> (defun ChangePlotConfig (configName styleSheet PlotRotation PaperSize Plotscale CenterPlot / app doc layout newOrigin)<br />   (vl-load-com)<br />   (setq app (vlax-get-acad-object)<br />         doc (vla-get-activedocument app)<br />         layout (vla-get-activelayout doc)<br />   )<br />   (vla-RefreshPlotDeviceInfo layout)<br />   (vla-put-configname layout configName)           ;打印机<br />   (vla-put-stylesheet layout styleSheet)           ;打印样式<br /> <br />   (if (= "纵向" PlotRotation)<br />       (vla-put-PlotRotation layout ac0Degrees)     ;图形方向  纵向<br />       (vla-put-PlotRotation layout ac90Degrees)    ;图形方向  横向<br />   )<br /> <br />   (setq index                                      ;开始修改纸张<br />        (vl-position (strcase PaperSize)<br />                     (mapcar (function strcase)<br />                             (GetPaperList1 configName)<br />                     )<br />       )<br />   )<br />   (vla-put-CanonicalMediaName layout (nth index (GetPaperList2 configName)))<br />   (princ)<br /> <br />   (if (= "按图纸空间缩放" Plotscale)               ;比例      按图纸空间缩放<br />       (vla-put-standardscale layout acScaleToFit)<br />       (progn<br />       (vla-put-standardscale layout acVpCustomScale)<br />       (vla-SetCustomScale layout 1 Plotscale)      ;比例      自定义比例1:Plotscale<br />       )<br />   )<br /> <br />   (if (= "居中打印" CenterPlot)<br />       (vla-put-CenterPlot layout :vlax-true)       ;居中打印<br />       (progn<br />       (vla-put-CenterPlot layout :vlax-false)      ;不居中打印<br />       (setq newOrigin (vlax-make-safearray vlax-vbDouble '(0 . 1)))<br />       (vlax-safearray-fill newOrigin (list 0 0))   ;设定打印偏移x为0，y为0<br />       (vla-put-PlotOrigin Layout newOrigin)<br />       )<br />   )<br />   ;(vla-SetWindowToPlot layout newOrigin newOrigin)<br />   ;(vla-put-PlotType layout acWindow)               ;打印范围  窗口<br /> <br />   (vla-put-paperunits layout acMillimeters)        ;单位      米<br />   (vla-put-PlotWithLineweights layout :vlax-true)  ;true: 使用打印型式中的线宽来打印 false: 使用图形文件中的线宽来打印<br /> )<br /> <br /> ;;; 获得某打印机纸张类型列表, 返回形如 "过大尺寸：ISO A2  (纵向)" "过大尺寸：ISO A2  (横向)".... 的列表<br /> ;;; 例:  (setq PaperSizes (GetPaperList1 "HP DesignJet 430 (E/A0) by HP" ))<br /> (defun GetPaperList1 (configName / app canpapersizearr canpapersizelist canpapersizevar app doc index layout papersize)<br />   (vl-load-com)<br />   (setq app (vlax-get-acad-object)<br />         doc (vla-get-activedocument app)<br />         layout (vla-get-activelayout doc)<br />   )<br />   (vla-put-configname layout configName)  ;将打印机设为当前打印机<br />   (vla-RefreshPlotDeviceInfo layout)<br />   (setq CanPaperSizeVar (vla-GetCanonicalMediaNames layout)<br />         CanPaperSizeArr (vlax-variant-value CanPaperSizeVar)<br />         CanPaperSizeLIst (vlax-safearray->list CanPaperSizeArr)<br />         PaperSize '()<br />         index 0<br />   )<br />   (repeat (length CanPaperSizeList)<br />           (setq Papersize (cons (vla-GetLocaleMediaName layout (nth index CanPaperSizeList)) Papersize)<br />                 index (1+ index)<br />           )<br />   )<br />   (reverse PaperSize)<br /> )<br /> <br /> ;;; 获得某打印机纸张类型列表, 返回形如 "User620" "User1644".... 的列表<br /> ;;; 例:  (setq PaperSizes (GetPaperList2 "HP DesignJet 430 (E/A0) by HP" ))<br /> (defun GetPaperList2 (configName / app canpapersizearr canpapersizelist canpapersizevar app doc layout)<br />   (vl-load-com)<br />   (setq app (vlax-get-acad-object)<br />         doc (vla-get-activedocument app)<br />         layout (vla-get-activelayout doc)<br />   )<br />   (vla-put-configname layout configName);将打印机设为当前打印机<br />   (vla-RefreshPlotDeviceInfo layout)<br />   (setq CanPaperSizeVar (vla-GetCanonicalMediaNames (vla-item (vla-get-layouts doc) "Model"))<br />         CanPaperSizeArr (vlax-variant-value CanPaperSizeVar)<br />         CanPaperSizeLIst (vlax-safearray->list CanPaperSizeArr)<br />   )<br /> )<br /> <br /> ;;; 在当前布局，把当前打印设置添加到一个新的页面设置，并置为当前<br /> ;;; (addPageSetup <PageSetupName>)<br /> ;;; 例: (AddPageSetup ("PageSetupName")<br /> (defun AddPageSetup (name / space pc lay PlotConfig)<br />   (setq app (vlax-get-acad-object)<br />         doc (vla-get-activedocument app)<br />         layout (vla-get-activelayout doc)<br />   )<br />   ; 删除已有的打印页面设置<br />   (vlax-for pc (vla-get-plotconfigurations doc)<br />     (if (= (strcase (vla-get-name pc)) (strcase name))<br />         (vla-delete pc)<br />     )<br />   )<br />   ; 添加到新的页面设置<br />   (if (= (getvar "ctab") "Model")<br />     (setq space :vlax-true<br />           lay (vla-get-Layout (vla-get-ModelSpace<br />                 (vla-get-activedocument (vlax-get-acad-object)))))<br />     (setq space :vlax-false<br />           lay (vla-get-ActiveLayout (vla-get-activedocument<br />                 (vlax-get-acad-object))))<br />   )<br />   (setq pc (vla-add<br />              (vla-get-plotconfigurations doc)<br />              name<br />              space))<br />   (vla-CopyFrom pc lay)<br />   (vla-put-name pc name)<br />   ; 把新添加的页面设置置为当前<br />   (setq PlotConfig (vl-catch-all-apply<br />          'vla-item<br />          (list<br />            (vla-get-PlotConfigurations<br />        doc<br />            )<br />            name<br />          )<br />        )<br />   )<br />   (if (not (vl-catch-all-error-p PlotConfig))<br />       (vla-copyfrom layout PlotConfig)<br />   )<br /> (princ)<br /> )<br /> <br /> (defun c:a1 ()<br />   (ChangePlotConfig "\\\\hp430\\hp designJet 430 (e/a0) by hp"  "蜡纸.ctb" "纵向" "过大尺寸：ISO A1  (纵向)" 100 "不居中打印")<br />   (AddPageSetup "蜡纸A1")<br />   (princ "\n当前打印机HP DesignJet 430,蜡纸,纵向进纸,纸张A1,1:100打印比例,居中打印! ")<br />   (princ "\n当前打印页面设置名为蜡纸A1! ")<br />   (princ)<br /> )<br /> <br /> (defun c:a2 ()<br />   (ChangePlotConfig "\\\\hp430\\hp designJet 430 (e/a0) by hp"  "蜡纸.ctb" "横向" "过大尺寸：ISO A2  (横向)" 100 "不居中打印")<br />   (AddPageSetup "蜡纸A2")<br />   (princ "\n当前打印机HP DesignJet 430,蜡纸,纵向进纸,纸张A2,1:100打印比例,居中打印! ")<br />   (princ "\n当前打印页面设置名为蜡纸A2! ")<br />   (princ)<br /> )<br /> <br /> (defun c:a3 ()<br />   (ChangePlotConfig "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "纵向" "A3" "按图纸空间缩放" "居中打印")<br />   (AddPageSetup "白纸A3")<br />   (princ "\n当前打印机Generic 16BW-5,白纸,纵向进纸,纸张A3,按图纸空间缩放,居中打印! ")<br />   (princ "\n当前打印页面设置名为纸张A3! ")<br />   (princ)<br /> )<br /> <br /> (defun c:a4 ()<br />   (ChangePlotConfig "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "横向" "A4" "按图纸空间缩放" "居中打印")<br />   (AddPageSetup "白纸A4")<br />   (princ "\n当前打印机Generic 16BW-5,白纸,横向进纸,纸张A4,按图纸空间缩放,居中打印! ")<br />   (princ "\n当前打印页面设置名为纸张A4! ")<br />   (princ)<br /> )

就是其中  
;(vla-SetWindowToPlot layout newOrigin newOrigin)
;(vla-put-PlotType layout acWindow)  
还是有问题，想设置打印范围为窗口模式，SetWindowToPlot 中的那两个点没什么用，因为后面还要用到秋枫的批量打印，
所以随便设了下，但还是不行，不知道什么问题

xiaoquansb

支持楼主创新

xiaoyingzi

大部分代码都是复制来的，只是东拼西凑组装了下而已

nxchenjk

不知楼主这个能不能打印指定文件夹下的全部文件。

zhuangxu_521

用什么命令调用呀？

xiaoyingzi

本程序只是打印设置用，调用命令A1，A2，A3，A4,但要改成自己的打印机和相应设置，否则是无法运行的

nxchenjk

好东西引用了。谢谢了。雪中送炭的感觉

s305040093

嗯  做个记号 过几天正要编类似程序 这下好了
谢谢楼主

adc

xiaoyingzi 发表于 2011-8-21 19:06
花了不少时间，终于自己解决了，最后配上秋枫的批量打印，自己用得很方便了
就是其中  
;(vla-SetWindowT ...

我的打印机是局域网的打印机，请问要怎样特别设置吗？我改成了自己的打印机名字和打印样式，但运行程序没有变化。