TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: iwill on August 31, 2020, 03:45:58 AM
-
Easy multi-file batch printing
1. Pre-set the page setting PS1
2. Print several open DWG files according to PS1
Problem is, the program can only print the current DWG file
It seems that vla-plottoFile can only print the current DWG
;;;缓存函数GETINT-YF (STR VAR)
(defun getint-yf (str var)
(princ str)
(if (and (/= var nil) (/= var ""))
(progn (princ "<")
(princ var)
(princ ">")
)
)
(princ ":")
(if (setq in (getint ""))
(setq var in)
(eval var)
)
)
(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)
)
-
I have a VBA and script that reads the contents of a folder and plots modelspace. The VBA opens each file and calls the script while the script executes the plot.