如何用lisp分别保存多个打印设置为打印页面设置
;修改多图档的打印配置示例 By carrot1983 12/1/09;xiaoyingzi 修改
(defun ChangePlotConfig (configName styleSheet papersize PlotRotation Plotscale / acApp acDocs layouts)
(vl-load-com)
(setq acApp (vlax-get-acad-object))
(setq acDocs (vla-get-documents acApp))
(vlax-for doc acDocs
(setq layouts (vla-get-layouts doc))
(vlax-for layout layouts
(vla-put-configname layout configName) ;打印机
(vla-put-stylesheet layout styleSheet) ;打印样式
(vla-put-CanonicalMediaName layout papersize) ;图纸尺寸
(if (= "纵向" PlotRotation)
(vla-put-PlotRotation layout ac0Degrees) ;图形方向纵向
(vla-put-PlotRotation layout ac90Degrees) ;图形方向横向
)
(if (= "按图纸空间缩放" Plotscale)
(vla-put-standardscale layout acScaleToFit);比例 按图纸空间缩放
(vla-put-standardscale layout ac1_100) ;比例 1:100
)
(vla-put-paperunits layout acMillimeters) ;单位 米
)
)
)
(defun c:a1 ()
(ChangePlotConfig "\\\\夏秀兰\\HP DesignJet 430" "蜡纸.ctb" "A3" "过大尺寸:ISO A1(纵向)" "纵向" "1:100" )
(princ "\n当前打印机Generic 16BW-5,纸张A4,白纸,横向进纸,按图纸空间缩放打印! ")
(princ)
)
(defun c:a2 ()
(ChangePlotConfig "\\\\夏秀兰\\HP DesignJet 430" "蜡纸.ctb" "A4" "过大尺寸:ISO A1(横向)" "横向" "1:100" )
(princ "\n当前打印机Generic 16BW-5,纸张A4,白纸,横向进纸,按图纸空间缩放打印! ")
(princ)
)
(defun c:a3 ()
(ChangePlotConfig "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "A3" "纵向" "按图纸空间缩放" )
(princ "\n当前打印机Generic 16BW-5,纸张A4,白纸,横向进纸,按图纸空间缩放打印! ")
(princ)
)
(defun c:a4 ()
(ChangePlotConfig "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "A4" "横向" "按图纸空间缩放" )
(princ "\n当前打印机Generic 16BW-5,纸张A4,白纸,横向进纸,按图纸空间缩放打印! ")
(princ)
)
如上代码,完成了以上4种设置后,如何用lisp实现分别保存这四种设置为四种页面设置,页面设置名默认设置为A1(白纸)、A2(白纸)、A3(蜡纸)、A4(蜡纸)
如果能实现,接下来再用秋枫的批量打印就很爽了
怎么增加自定义图纸尺寸的设定,比如一些加长图纸 简易的多文件批量打印 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) ) 更新下两个:以前只能获取打印机,不能获取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 于 2011-8-21 19:11 编辑
花了不少时间,终于自己解决了,最后配上秋枫的批量打印,自己用得很方便了;;;xiaoyingzi 2011.08.21
;;; 修改当前图档的打印配置
(defun ChangePlotConfig (configName styleSheet PlotRotation PaperSize Plotscale CenterPlot / app doc layout newOrigin)
(vl-load-com)
(setq app (vlax-get-acad-object)
doc (vla-get-activedocument app)
layout (vla-get-activelayout doc)
)
(vla-RefreshPlotDeviceInfo layout)
(vla-put-configname layout configName) ;打印机
(vla-put-stylesheet layout styleSheet) ;打印样式
(if (= "纵向" PlotRotation)
(vla-put-PlotRotation layout ac0Degrees) ;图形方向纵向
(vla-put-PlotRotation layout ac90Degrees) ;图形方向横向
)
(setq index ;开始修改纸张
(vl-position (strcase PaperSize)
(mapcar (function strcase)
(GetPaperList1 configName)
)
)
)
(vla-put-CanonicalMediaName layout (nth index (GetPaperList2 configName)))
(princ)
(if (= "按图纸空间缩放" Plotscale) ;比例 按图纸空间缩放
(vla-put-standardscale layout acScaleToFit)
(progn
(vla-put-standardscale layout acVpCustomScale)
(vla-SetCustomScale layout 1 Plotscale) ;比例 自定义比例1:Plotscale
)
)
(if (= "居中打印" CenterPlot)
(vla-put-CenterPlot layout :vlax-true) ;居中打印
(progn
(vla-put-CenterPlot layout :vlax-false) ;不居中打印
(setq newOrigin (vlax-make-safearray vlax-vbDouble '(0 . 1)))
(vlax-safearray-fill newOrigin (list 0 0)) ;设定打印偏移x为0,y为0
(vla-put-PlotOrigin Layout newOrigin)
)
)
;(vla-SetWindowToPlot layout newOrigin newOrigin)
;(vla-put-PlotType layout acWindow) ;打印范围窗口
(vla-put-paperunits layout acMillimeters) ;单位 米
(vla-put-PlotWithLineweights layout :vlax-true);true: 使用打印型式中的线宽来打印 false: 使用图形文件中的线宽来打印
)
;;; 获得某打印机纸张类型列表, 返回形如 "过大尺寸:ISO A2(纵向)" "过大尺寸:ISO A2(横向)".... 的列表
;;; 例:(setq PaperSizes (GetPaperList1 "HP DesignJet 430 (E/A0) by HP" ))
(defun GetPaperList1 (configName / app canpapersizearr canpapersizelist canpapersizevar app doc index layout papersize)
(vl-load-com)
(setq app (vlax-get-acad-object)
doc (vla-get-activedocument app)
layout (vla-get-activelayout doc)
)
(vla-put-configname layout configName);将打印机设为当前打印机
(vla-RefreshPlotDeviceInfo layout)
(setq CanPaperSizeVar (vla-GetCanonicalMediaNames layout)
CanPaperSizeArr (vlax-variant-value CanPaperSizeVar)
CanPaperSizeLIst (vlax-safearray->list CanPaperSizeArr)
PaperSize '()
index 0
)
(repeat (length CanPaperSizeList)
(setq Papersize (cons (vla-GetLocaleMediaName layout (nth index CanPaperSizeList)) Papersize)
index (1+ index)
)
)
(reverse PaperSize)
)
;;; 获得某打印机纸张类型列表, 返回形如 "User620" "User1644".... 的列表
;;; 例:(setq PaperSizes (GetPaperList2 "HP DesignJet 430 (E/A0) by HP" ))
(defun GetPaperList2 (configName / app canpapersizearr canpapersizelist canpapersizevar app doc layout)
(vl-load-com)
(setq app (vlax-get-acad-object)
doc (vla-get-activedocument app)
layout (vla-get-activelayout doc)
)
(vla-put-configname layout configName);将打印机设为当前打印机
(vla-RefreshPlotDeviceInfo layout)
(setq CanPaperSizeVar (vla-GetCanonicalMediaNames (vla-item (vla-get-layouts doc) "Model"))
CanPaperSizeArr (vlax-variant-value CanPaperSizeVar)
CanPaperSizeLIst (vlax-safearray->list CanPaperSizeArr)
)
)
;;; 在当前布局,把当前打印设置添加到一个新的页面设置,并置为当前
;;; (addPageSetup <PageSetupName>)
;;; 例: (AddPageSetup ("PageSetupName")
(defun AddPageSetup (name / space pc lay PlotConfig)
(setq app (vlax-get-acad-object)
doc (vla-get-activedocument app)
layout (vla-get-activelayout doc)
)
; 删除已有的打印页面设置
(vlax-for pc (vla-get-plotconfigurations doc)
(if (= (strcase (vla-get-name pc)) (strcase name))
(vla-delete pc)
)
)
; 添加到新的页面设置
(if (= (getvar "ctab") "Model")
(setq space :vlax-true
lay (vla-get-Layout (vla-get-ModelSpace
(vla-get-activedocument (vlax-get-acad-object)))))
(setq space :vlax-false
lay (vla-get-ActiveLayout (vla-get-activedocument
(vlax-get-acad-object))))
)
(setq pc (vla-add
(vla-get-plotconfigurations doc)
name
space))
(vla-CopyFrom pc lay)
(vla-put-name pc name)
; 把新添加的页面设置置为当前
(setq PlotConfig (vl-catch-all-apply
'vla-item
(list
(vla-get-PlotConfigurations
doc
)
name
)
)
)
(if (not (vl-catch-all-error-p PlotConfig))
(vla-copyfrom layout PlotConfig)
)
(princ)
)
(defun c:a1 ()
(ChangePlotConfig "\\\\hp430\\hp designJet 430 (e/a0) by hp""蜡纸.ctb" "纵向" "过大尺寸:ISO A1(纵向)" 100 "不居中打印")
(AddPageSetup "蜡纸A1")
(princ "\n当前打印机HP DesignJet 430,蜡纸,纵向进纸,纸张A1,1:100打印比例,居中打印! ")
(princ "\n当前打印页面设置名为蜡纸A1! ")
(princ)
)
(defun c:a2 ()
(ChangePlotConfig "\\\\hp430\\hp designJet 430 (e/a0) by hp""蜡纸.ctb" "横向" "过大尺寸:ISO A2(横向)" 100 "不居中打印")
(AddPageSetup "蜡纸A2")
(princ "\n当前打印机HP DesignJet 430,蜡纸,纵向进纸,纸张A2,1:100打印比例,居中打印! ")
(princ "\n当前打印页面设置名为蜡纸A2! ")
(princ)
)
(defun c:a3 ()
(ChangePlotConfig "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "纵向" "A3" "按图纸空间缩放" "居中打印")
(AddPageSetup "白纸A3")
(princ "\n当前打印机Generic 16BW-5,白纸,纵向进纸,纸张A3,按图纸空间缩放,居中打印! ")
(princ "\n当前打印页面设置名为纸张A3! ")
(princ)
)
(defun c:a4 ()
(ChangePlotConfig "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "横向" "A4" "按图纸空间缩放" "居中打印")
(AddPageSetup "白纸A4")
(princ "\n当前打印机Generic 16BW-5,白纸,横向进纸,纸张A4,按图纸空间缩放,居中打印! ")
(princ "\n当前打印页面设置名为纸张A4! ")
(princ)
)
就是其中
;(vla-SetWindowToPlot layout newOrigin newOrigin)
;(vla-put-PlotType layout acWindow)
还是有问题,想设置打印范围为窗口模式,SetWindowToPlot 中的那两个点没什么用,因为后面还要用到秋枫的批量打印,
所以随便设了下,但还是不行,不知道什么问题
支持楼主创新 本帖最后由 xiaoyingzi 于 2011-8-26 13:26 编辑
大部分代码都是复制来的,只是东拼西凑组装了下而已 不知楼主这个能不能打印指定文件夹下的全部文件。 用什么命令调用呀? 本程序只是打印设置用,调用命令A1,A2,A3,A4,但要改成自己的打印机和相应设置,否则是无法运行的 好东西引用了。谢谢了。雪中送炭的感觉 嗯做个记号 过几天正要编类似程序 这下好了
谢谢楼主 xiaoyingzi 发表于 2011-8-21 19:06 static/image/common/back.gif
花了不少时间,终于自己解决了,最后配上秋枫的批量打印,自己用得很方便了
就是其中
;(vla-SetWindowT ...
我的打印机是局域网的打印机,请问要怎样特别设置吗?我改成了自己的打印机名字和打印样式,但运行程序没有变化。