【K:GetPaperLst】获取打印机纸张

kucha007

获取打印机的纸张,稍微梳理了一下，源码来自这里：
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=55949&highlight=%B4%F2%D3%A1%BB%FA%2B%D6%BD%D5%C5

1. ;获取打印机纸张
   
2. (defun K:GetPaperLst (PrintNam/ DOC Layout)
   
3.   (vl-load-com)
   
4.   (setq DOC    (vla-get-ActiveDocument (vlax-get-acad-object))
   
5.         Layout (vla-get-activeLayout DOC)
   
6.   )
   
7.   (vla-put-configname layout PrintNam) ;设置当前打印机
   
8.   (vla-RefreshPlotDeviceInfo Layout) ;更新打印机、规范介质和打印样式表信息
   
9.   (mapcar
   
10.     '(lambda (xx)
    
11.        (vla-GetLocaleMediaName Layout xx)
    
12.      )
    
13.     (vlax-safearray->list (vlax-variant-value (vla-GetCanonicalMediaNames Layout)))
    
14.   )
    
15. )
    

;获取打印机纸张<br /> (defun K:GetPaperLst (PrintNam/ DOC Layout) <br />   (vl-load-com)<br />   (setq DOC    (vla-get-ActiveDocument (vlax-get-acad-object))<br />         Layout (vla-get-activeLayout DOC)<br />   )<br />   (vla-put-configname layout PrintNam) ;设置当前打印机<br />   (vla-RefreshPlotDeviceInfo Layout) ;更新打印机、规范介质和打印样式表信息<br />   (mapcar <br />     '(lambda (xx) <br />        (vla-GetLocaleMediaName Layout xx)<br />      )<br />     (vlax-safearray->list (vlax-variant-value (vla-GetCanonicalMediaNames Layout)))<br />   )<br /> )<br />

如果你只想获取自定义的纸张，可以移除不含关键词"UserDefinedMetric"的元素

1. (defun k:Remove-NoChar (Lst Char / item NewLst)
   
2.   (setq NewLst '())
   
3.   (foreach item Lst
   
4.     (if (vl-string-search Char item)
   
5.       (setq NewLst (cons item NewLst))
   
6.     )
   
7.   )
   
8.   (reverse NewLst)
   
9. )
   

(defun k:Remove-NoChar (Lst Char / item NewLst) <br />   (setq NewLst '())<br />   (foreach item Lst <br />     (if (vl-string-search Char item)<br />       (setq NewLst (cons item NewLst))<br />     )<br />   )<br />   (reverse NewLst)<br /> )<br />

kucha007

也可以这样改写：Flag为T时只获取自定义的纸张

1. ;获取打印机纸张
   
2. (defun K:GetPaperLst (PrintNam Flag / DOC Layout PaperLst)
   
3.   (vl-load-com)
   
4.   (defun k:Remove-NoChar (Lst Char / item NewLst)
   
5.     (setq NewLst '())
   
6.     (foreach item Lst
   
7.       (if (vl-string-search Char item)
   
8.         (setq NewLst (cons item NewLst))
   
9.       )
   
10.     )
    
11.     (reverse NewLst)
    
12.   )
    
13.   (setq DOC    (vla-get-ActiveDocument (vlax-get-acad-object))
    
14.         Layout (vla-get-activeLayout DOC)
    
15.   )
    
16.   (vla-put-configname layout PrintNam) ;设置当前打印机
    
17.   (vla-RefreshPlotDeviceInfo Layout) ;更新打印机、规范介质和打印样式表信息
    
18.   (setq PaperLst (vlax-safearray->list (vlax-variant-value (vla-GetCanonicalMediaNames Layout))))
    
19.   (mapcar
    
20.     '(lambda (xx)
    
21.        (vla-GetLocaleMediaName Layout xx)
    
22.      )
    
23.     (if (= Flag T)
    
24.       (k:Remove-NoChar PaperLst "UserDefinedMetric")
    
25.       PaperLst
    
26.     )
    
27.   )
    
28. )
    

;获取打印机纸张<br /> (defun K:GetPaperLst (PrintNam Flag / DOC Layout PaperLst) <br />   (vl-load-com)<br />   (defun k:Remove-NoChar (Lst Char / item NewLst) <br />     (setq NewLst '())<br />     (foreach item Lst <br />       (if (vl-string-search Char item) <br />         (setq NewLst (cons item NewLst))<br />       )<br />     )<br />     (reverse NewLst)<br />   )<br />   (setq DOC    (vla-get-ActiveDocument (vlax-get-acad-object))<br />         Layout (vla-get-activeLayout DOC)<br />   )<br />   (vla-put-configname layout PrintNam) ;设置当前打印机<br />   (vla-RefreshPlotDeviceInfo Layout) ;更新打印机、规范介质和打印样式表信息<br />   (setq PaperLst (vlax-safearray->list (vlax-variant-value (vla-GetCanonicalMediaNames Layout))))<br />   (mapcar <br />     '(lambda (xx) <br />        (vla-GetLocaleMediaName Layout xx)<br />      )<br />     (if (= Flag T)<br />       (k:Remove-NoChar PaperLst "UserDefinedMetric")<br />       PaperLst<br />     ) <br />   )<br /> )<br />

lxl217114

感觉离一个批打工具不远了。很6

kucha007

结合这个帖子调整成这样也许会好一点http://bbs.mjtd.com/thread-187356-1-1.html

1. (defun K:GetPaperLst (PrintNam Flag / DOC Layout PaperLst xx)
   
2.   (vl-load-com)
   
3.   (setq DOC    (vla-get-ActiveDocument (vlax-get-acad-object))
   
4.         Layout (vla-get-activeLayout DOC)
   
5.   )
   
6.   (vla-put-configname layout PrintNam) ;设置当前打印机
   
7.   (vla-RefreshPlotDeviceInfo Layout) ;更新打印机、规范介质和打印样式表信息
   
8.   (setq PaperLst (vlax-safearray->list (vlax-variant-value (vla-GetCanonicalMediaNames Layout))))
   
9.   (if (= Flag T);只获取自定义纸张
   
10.     (list
    
11.       (mapcar
    
12.         '(lambda (xx)
    
13.           (vla-GetLocaleMediaName Layout xx)
    
14.         )
    
15.         (k:Remove-NoChar PaperLst "UserDefinedMetric")
    
16.       )
    
17.       (mapcar
    
18.         '(lambda (XX)
    
19.           (K:GetPaperType (car (K:Str2NumLst XX)) (cadr (K:Str2NumLst XX)))
    
20.         )
    
21.         (k:Remove-NoChar PaperLst "UserDefinedMetric")
    
22.       )
    
23.     )
    
24.     (list
    
25.       (mapcar
    
26.         '(lambda (xx)
    
27.           (vla-GetLocaleMediaName Layout xx)
    
28.         )
    
29.         PaperLst
    
30.       )
    
31.       
    
32.     )
    
33.   )
    
34. )
    

(defun K:GetPaperLst (PrintNam Flag / DOC Layout PaperLst xx) <br />   (vl-load-com)<br />   (setq DOC    (vla-get-ActiveDocument (vlax-get-acad-object))<br />         Layout (vla-get-activeLayout DOC)<br />   )<br />   (vla-put-configname layout PrintNam) ;设置当前打印机<br />   (vla-RefreshPlotDeviceInfo Layout) ;更新打印机、规范介质和打印样式表信息<br />   (setq PaperLst (vlax-safearray->list (vlax-variant-value (vla-GetCanonicalMediaNames Layout))))<br />   (if (= Flag T);只获取自定义纸张<br />     (list<br />       (mapcar <br />         '(lambda (xx) <br />           (vla-GetLocaleMediaName Layout xx)<br />         )<br />         (k:Remove-NoChar PaperLst "UserDefinedMetric")<br />       )<br />       (mapcar <br />         '(lambda (XX)<br />           (K:GetPaperType (car (K:Str2NumLst XX)) (cadr (K:Str2NumLst XX)))<br />         )<br />         (k:Remove-NoChar PaperLst "UserDefinedMetric")<br />       )<br />     )<br />     (list<br />       (mapcar <br />         '(lambda (xx) <br />           (vla-GetLocaleMediaName Layout xx)<br />         )<br />         PaperLst <br />       )<br />       <br />     )<br />   )<br /> )<br />

yefei812678

这是干什么用的