修改为窗口模式以及在图纸空间,使用时打印类型为布局时出错问题。
- ;;; 修改当前图档的打印配置
- (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)
- ;;;增加打印窗口设置 by edata 2014-6-10
- (setq newOrigin1 (vlax-make-safearray vlax-vbDouble '(0 . 1))
- newOrigin2(vlax-make-safearray vlax-vbDouble '(0 . 1)))
- (vlax-safearray-fill newOrigin1 (list 0 0))
- (vlax-safearray-fill newOrigin2 (list 420 297))
- (vla-SetWindowToPlot layout newOrigin1 newOrigin2)
- (vla-put-PlotType layout acWindow) ;打印范围 窗口
- ;;;判断是否为类型layout,layout会锁定下面这两项 by edata ,当然上面设置成窗口则没有此问题
- (if (/= (vla-get-PlotType layout) 5)
- (progn
- (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 newOrigin1)
- )
- )
- )
- )
- ;(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)
- )
- )
- ;;; 获得当前激活的布局的图纸尺寸
- ;;; 例: (setq PaperSize (GetPaperSizes))
- (defun GetPaperSizes ( / Papersize)
- (setq layout (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
- (vla-RefreshPlotDeviceInfo layout)
- (setq Papersize (vla-get-CanonicalMediaName layout))
- )
- ;;; 在当前布局,把当前打印设置添加到一个新的页面设置,并置为当前
- ;;; (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 getcurrentprinter (/ strprint)
- (setq strprint
- (vl-registry-read
- (strcat
- "HKEY_CURRENT_USER\\Software\\Microsoft\\"
- "Windows NT\\CurrentVersion\\Windows"
- )
- "Device"
- )
- )
- (substr strprint 1 (vl-string-search "," strprint))
- )
- ;;; 取得系统全部打印机
- (defun getallprinters (/ return wshnetwork printlst i)
- (vl-catch-all-apply
- '(lambda ()
- (setq WshNetwork (vlax-create-object "wscript.Network"))
- (setq return (vlax-invoke WshNetwork 'EnumPrinterConnections))
- (setq i 1)
- (vlax-release-object WshNetwork)
- (repeat (/ (vlax-get return 'length) 2)
- (setq printlst (cons (vla-item return i) printlst))
- (setq i (+ 2 i))
- )
- )
- )
- printlst
- )
- ;;; 设置系统默认打印机
- (defun setcurrentprinter (printername / wshnetwork)
- (if (null
- (vl-catch-all-apply
- '(lambda ()
- (setq WshNetwork (vlax-create-object "wscript.Network"))
- (vlax-invoke WshNetwork 'SetDefaultPrinter printername)
- )
- )
- )
- t
- )
- )
- ;;; 取得系统全部打印样式表名
- (defun getallplotstyletables ()
- (vlax-safeArray->list
- (vlax-variant-value
- (vla-Getplotstyletablenames (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object))))
- )
- )
- )
- ;;; 检查打印设置是否正确
- (defun checkplotconfig (myprintername myplotstyletable mypapersize / papersize plotstyletable printername)
- (if (member myprintername (getallprinters))
- (if (not (member mypapersize (GetPaperList1 myprintername)))
- (progn
- (princ (strcat "\n输入的纸张【" mypapersize "】不正确!!!\n"))
- (princ (strcat "\n打印机" myprintername "的所有纸张列表为:\n"))
- (foreach papersize (GetPaperList1 myprintername)
- (print papersize)
- )
- )
- )
- (progn
- (princ (strcat "\n输入的打印机名称【" myprintername "】不正确!!!\n"))
- (princ "\n当前所有打印机名称列表为:\n")
- (foreach printername (getallprinters)
- (print printername)
- )
- )
- )
- (if (not (member myplotstyletable (getallplotstyletables)))
- (progn
- (princ (strcat "\n输入的打印样式表的文件名【" myplotstyletable "】不正确!!!\n"))
- (princ "\n当前所有打印样式表文件名列表为:\n")
- (foreach plotstyletable (getallplotstyletables)
- (print plotstyletable)
- )
- )
- )
- )
- ;;; 自定义快速打印设置和批量打印
- (defun myquickplot (printername plotstyletable plotrotation papersize plotscale CenterPlot pagesetupname)
- (if (= plotscale "按图纸空间缩放")
- (setq showscale "按图纸空间缩放")
- (setq showscale (strcat "1:" (itoa plotscale)))
- )
- (if (and
- (member printername (getallprinters))
- (member papersize (GetPaperList1 printername))
- (member plotstyletable (getallplotstyletables))
- )
- (progn
- (ChangePlotConfig printername plotstyletable plotrotation papersize plotscale CenterPlot)
- (AddPageSetup pagesetupname)
- (princ (strcat "\n当前打印机" printername "," plotstyletable ","
- plotrotation "," papersize "," showscale "," CenterPlot "! "))
- (princ (strcat "\n当前打印页面设置名为" pagesetupname "! "))
- (if (findfile "批量打印.vlx")
- (progn
- (if (not (vl-vlx-loaded-p "批量打印"))
- (load (findfile "批量打印.vlx"))
- )
- (c:batchplot)
- )
- )
- )
- (checkplotconfig printername plotstyletable papersize)
- )
- (princ)
- )
- ;自定义按图幅快速打印
- (defun c:a1 ()
- (myquickplot "\\\\HP430\\HP DesignJet 430 (E/A0) by HP" "蜡纸.ctb" "纵向" "过大尺寸:ISO A1 (纵向)" 100 "不居中打印" "蜡纸A1")
- (princ)
- )
- (defun c:a2 ()
- (myquickplot "\\\\HP430\\HP DesignJet 430 (E/A0) by HP" "蜡纸.ctb" "横向" "过大尺寸:ISO A2 (横向)" 100 "不居中打印" "蜡纸A2")
- (princ)
- )
- (defun c:a3 ()
- (myquickplot "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "纵向" "A3" "按图纸空间缩放" "居中打印" "白纸A3")
- (princ)
- )
- (defun c:a4 ()
- (myquickplot "\\\\打印机\\Generic 16BW-5" "白纸.ctb" "横向" "A4" "按图纸空间缩放" "居中打印" "白纸A4")
- (princ)
- )
|