kucha007 发表于 2023-3-12 02:34:47

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

本帖最后由 kucha007 于 2023-3-14 09:50 编辑

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



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



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

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




kucha007 发表于 2023-3-12 03:04:06

本帖最后由 kucha007 于 2023-3-12 17:28 编辑

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


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



lxl217114 发表于 2023-3-12 22:26:34

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

kucha007 发表于 2023-3-15 00:24:57


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


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



yefei812678 发表于 2024-2-24 11:55:32

这是干什么用的
页: [1]
查看完整版本: 【K:GetPaperLst】获取打印机纸张