AI 编写了一个多文档批量打印的插件
本帖最后由 zhanghuohuo 于 2025-11-30 21:20 编辑(defun c:BPLOT (/ *error* dcl-file dcl-id result
get-plotters get-styles get-media-names
update-media-list update-file-list write-dcl browse-folder
valid-folder-p save-settings load-settings
generate-worker-lsp generate-scr-file
smart-sort path-slash prepare-temp-env
remove-selected-file browse-multi-files
plotters styles media-list pick-block
sel-block sel-plotter sel-style sel-media sel-scale sel-factor
sel-folder file-list selected-file-idx
acad-obj doc clayout reg-path factor-num
worker-path scr-path temp loop temp-dir input-path)
(vl-load-com)
(setq acad-obj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acad-obj))
(setq clayout (vla-get-ActiveLayout doc))
(setq reg-path "HKEY_CURRENT_USER\\Software\\BatchPlotTool_SCR")
(setq file-list nil)
(setq selected-file-idx nil)
(setq input-path "")
(defun *error* (msg)
(if dcl-id (unload_dialog dcl-id))
(if (and dcl-file (findfile dcl-file)) (vl-file-delete dcl-file))
(if (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*")))
(princ (strcat "\n错误: " msg))
)
(princ)
)
;; ========== 基础工具 ==========
(defun path-slash (path)
(while (vl-string-search "\\" path)
(setq path (vl-string-subst "/" "\\" path))
)
path
)
(defun smart-sort (lst / extract-number)
(defun extract-number (s / i len c num found)
(setq i 1 len (strlen s) num "" found nil)
(while (and (<= i len) (not (wcmatch (substr s i 1) "#")))
(setq i (1+ i))
)
(while (and (<= i len) (wcmatch (setq c (substr s i 1)) "#"))
(setq num (strcat num c) i (1+ i) found T)
)
(if found (atoi num) 999999)
)
(vl-sort lst
'(lambda (a b / na nb)
(setq na (extract-number a) nb (extract-number b))
(if (= na nb)
(< a b)
(< na nb)
)
)
)
)
(defun smart-sort-paths (lst)
(vl-sort lst
'(lambda (a b / na nb)
(setq na (extract-number (vl-filename-base a)))
(setq nb (extract-number (vl-filename-base b)))
(if (= na nb)
(< (strcase (vl-filename-base a)) (strcase (vl-filename-base b)))
(< na nb)
)
)
)
)
(defun extract-number (s / i len c num found)
(setq i 1 len (strlen s) num "" found nil)
(while (and (<= i len) (not (wcmatch (substr s i 1) "#")))
(setq i (1+ i))
)
(while (and (<= i len) (wcmatch (setq c (substr s i 1)) "#"))
(setq num (strcat num c) i (1+ i) found T)
)
(if found (atoi num) 999999)
)
(defun prepare-temp-env (file-list temp-dir / fso src-path temp-path file-obj attrs copied-count fname)
(setq fso (vlax-create-object "Scripting.FileSystemObject"))
(if (vlax-invoke fso 'FolderExists temp-dir)
(vl-catch-all-apply 'vlax-invoke (list fso 'DeleteFolder temp-dir :vlax-true))
)
(vl-mkdir temp-dir)
(setq copied-count 0)
(if file-list
(progn
(princ "\n[系统] 正在初始化临时环境...")
(foreach src-path file-list
(setq fname (vl-filename-base src-path))
(setq temp-path (strcat temp-dir "\\" fname ".dwg"))
(if (vl-file-copy src-path temp-path)
(progn
(if (setq file-obj (vl-catch-all-apply 'vlax-invoke (list fso 'GetFile temp-path)))
(if (not (vl-catch-all-error-p file-obj))
(progn
(setq attrs (vlax-get file-obj 'Attributes))
(if (= (logand attrs 1) 1)
(vlax-put file-obj 'Attributes (logand attrs 65534))
)
(vlax-release-object file-obj)
)
)
)
(setq copied-count (1+ copied-count))
(princ (strcat "\n-> 副本就绪: " fname ".dwg"))
)
)
)
)
)
(if fso (vlax-release-object fso))
(if (> copied-count 0) T nil)
)
;; ========== 界面配置函数 ==========
(defun get-plotters ()
(vla-RefreshPlotDeviceInfo clayout)
(vlax-safearray->list (vlax-variant-value (vla-GetPlotDeviceNames clayout)))
)
(defun get-styles ()
(vla-RefreshPlotDeviceInfo clayout)
(vlax-safearray->list (vlax-variant-value (vla-GetPlotStyleTableNames clayout)))
)
(defun get-media-names (plotter / media err)
(setq media nil)
(if (and plotter (/= plotter ""))
(progn
(setq err (vl-catch-all-apply 'vla-put-ConfigName (list clayout plotter)))
(if (not (vl-catch-all-error-p err))
(progn
(vla-RefreshPlotDeviceInfo clayout)
(setq media (vl-catch-all-apply
'(lambda () (vlax-safearray->list (vlax-variant-value (vla-GetCanonicalMediaNames clayout))))
nil))
(if (vl-catch-all-error-p media) (setq media nil))
)
)
)
)
media
)
(defun browse-folder (msg / sh folder folderobj path)
(setq path nil)
(setq sh (vla-getInterfaceObject acad-obj "Shell.Application"))
(if sh
(progn
(setq folder (vl-catch-all-apply 'vlax-invoke-method (list sh 'BrowseForFolder 0 msg 0)))
(if (and folder (not (vl-catch-all-error-p folder)))
(progn
(setq folderobj (vlax-get-property folder 'Self))
(setq path (vlax-get-property folderobj 'Path))
(vlax-release-object folderobj)
(vlax-release-object folder)
)
)
(vlax-release-object sh)
)
)
(if (and path (> (strlen path) 0))
(if (/= (substr path (strlen path) 1) "\\")
(setq path (strcat path "\\"))
)
)
path
)
(defun browse-single-file (/ result)
(setq result (getfiled "选择DWG文件 (可多次添加)" "" "dwg" 4))
result
)
(defun valid-folder-p (folder)
(and folder (= (type folder) 'STR) (> (strlen folder) 0))
)
(defun pick-block (/ ent obj name)
(setq name nil)
(princ "\n选择图框块...")
(while (null name)
(setq ent (car (entsel "\n点击选择图框块: ")))
(if ent
(progn
(setq obj (vlax-ename->vla-object ent))
(if (= (vla-get-ObjectName obj) "AcDbBlockReference")
(if (vlax-property-available-p obj 'EffectiveName)
(setq name (vla-get-EffectiveName obj))
(setq name (vla-get-Name obj))
)
(princ "\n不是块引用")
)
)
(setq name "")
)
)
name
)
(defun save-settings ()
(vl-registry-write reg-path "Block" (if sel-block sel-block ""))
(vl-registry-write reg-path "Printer" (if sel-plotter sel-plotter ""))
(vl-registry-write reg-path "Style" (if sel-style sel-style ""))
(vl-registry-write reg-path "Media" (if sel-media sel-media ""))
(vl-registry-write reg-path "Scale" (if sel-scale sel-scale "ScaleToFit"))
(vl-registry-write reg-path "Factor" (if sel-factor sel-factor "1.0"))
(vl-registry-write reg-path "Folder" (if sel-folder sel-folder ""))
)
(defun load-settings ()
(setq sel-block (vl-registry-read reg-path "Block"))
(setq sel-plotter (vl-registry-read reg-path "Printer"))
(setq sel-style (vl-registry-read reg-path "Style"))
(setq sel-media (vl-registry-read reg-path "Media"))
(setq sel-scale (vl-registry-read reg-path "Scale"))
(setq sel-factor (vl-registry-read reg-path "Factor"))
(setq sel-folder (vl-registry-read reg-path "Folder"))
(if (or (not sel-scale) (= sel-scale "")) (setq sel-scale "ScaleToFit"))
(if (or (not sel-factor) (= sel-factor "")) (setq sel-factor "1.0"))
)
;; ========== 文件列表管理 ==========
(defun load-folder-files (folder / files full-path)
(if (valid-folder-p folder)
(progn
(if (= (substr folder (strlen folder) 1) "\\")
(setq folder (substr folder 1 (1- (strlen folder))))
)
(setq files (vl-directory-files folder "*.dwg" 1))
(setq files (smart-sort files))
(setq file-list nil)
(foreach f files
(setq full-path (strcat folder "\\" f))
(setq file-list (append file-list (list full-path)))
)
)
)
file-list
)
(defun update-file-list-display ()
(start_list "lst_files")
(if file-list
(foreach f file-list
(add_list (strcat (vl-filename-base f) ".dwg"))
)
(add_list "(空)")
)
(end_list)
(set_tile "txt_count" (strcat "共 " (itoa (length file-list)) " 个文件"))
)
(defun update-path-display (idx)
(if (and file-list idx (>= idx 0) (< idx (length file-list)))
(progn
(setq input-path (nth idx file-list))
(set_tile "txt_path" input-path)
)
)
)
(defun remove-selected-file (idx / i new-list)
(if (and idx (>= idx 0) (< idx (length file-list)))
(progn
(setq i 0 new-list nil)
(foreach f file-list
(if (/= i idx)
(setq new-list (append new-list (list f)))
)
(setq i (1+ i))
)
(setq file-list new-list)
)
)
)
(defun add-file-to-list (filepath)
(if (and filepath
(findfile filepath)
(wcmatch (strcase filepath) "*.DWG")
(not (member filepath file-list)))
(progn
(setq file-list (append file-list (list filepath)))
(setq file-list (smart-sort-paths file-list))
T
)
nil
)
)
(defun load-from-input-path (path / clean-path)
(if (and path (/= path ""))
(progn
(setq clean-path (vl-string-trim " \t" path))
(if (= (substr clean-path (strlen clean-path) 1) "\\")
(setq clean-path (substr clean-path 1 (1- (strlen clean-path))))
)
(cond
((and (wcmatch (strcase clean-path) "*.DWG")
(findfile clean-path))
(if (add-file-to-list clean-path)
(progn
(princ (strcat "\n已添加文件: " (vl-filename-base clean-path)))
T
)
(progn
(princ "\n文件已存在或无效")
nil
)
)
)
((vl-file-directory-p clean-path)
(setq sel-folder (strcat clean-path "\\"))
(load-folder-files sel-folder)
(if file-list
(progn
(princ (strcat "\n已从文件夹加载 " (itoa (length file-list)) " 个文件"))
T
)
(progn
(princ "\n文件夹中没有DWG文件")
nil
)
)
)
(T
(alert (strcat "无效路径:\n" clean-path "\n\n请输入有效的文件夹路径或DWG文件路径"))
nil
)
)
)
nil
)
)
(defun update-factor-state (scale-mode)
(if (= scale-mode "ScaleToFit")
(mode_tile "txt_factor" 0)
(mode_tile "txt_factor" 1)
)
)
;; ========== 生成 Worker.lsp ==========
(defun generate-worker-lsp (filepath block printer style media scale-mode factor / f)
(setq f (open filepath "w"))
(if f
(progn
(write-line ";; BatchPlot Worker V1.0" f)
(write-line "(princ \"\\n 加载中...\")" f)
(write-line "(defun ss->list (ss / n lst)" f)
(write-line "(if ss (repeat (setq n (sslength ss)) (setq lst (cons (ssname ss (setq n (1- n))) lst)))) lst)" f)
(write-line "(defun ax:2dpoint (pt)" f)
(write-line "(vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 1)) (list (float (car pt)) (float (cadr pt))))))" f)
(write-line "(defun shrink-bounding (bd factor / ll ur cx cy hw hh)" f)
(write-line "(setq ll (car bd) ur (cadr bd))" f)
(write-line "(setq cx (/ (+ (car ll) (car ur)) 2.0) cy (/ (+ (cadr ll) (cadr ur)) 2.0))" f)
(write-line "(setq hw (/ (- (car ur) (car ll)) 2.0 factor) hh (/ (- (cadr ur) (cadr ll)) 2.0 factor))" f)
(write-line "(list (list (- cx hw) (- cy hh)) (list (+ cx hw) (+ cy hh))))" f)
(write-line "(defun islandscape (bd) (> (abs (- (caadr bd) (caar bd))) (abs (- (cadadr bd) (cadar bd)))))" f)
(write-line "(defun getwidth (bd) (max (abs (- (caadr bd) (caar bd))) (abs (- (cadadr bd) (cadar bd)))))" f)
(write-line "(defun fixscale (n / i large)" f)
(write-line "(setq i 0 large (> n 100))" f)
(write-line "(while (or (> n 100) (< n 10)) (if large (setq n (/ n 10.0)) (setq n (* n 10.0))) (setq i (1+ i)))" f)
(write-line "(setq n (fix (+ 0.5 n)))" f)
(write-line "(repeat i (if large (setq n (* n 10.0)) (setq n (/ n 10.0)))) n)" f)
(write-line "(defun sort-frames (bdlist / fuzz)" f)
(write-line "(setq fuzz 10.0)" f)
(write-line "(vl-sort bdlist '(lambda (a b)" f)
(write-line " (if (equal (caar a) (caar b) fuzz) (> (cadar a) (cadar b)) (< (caar a) (caar b))))))" f)
(write-line "(defun str-split (str delim / lst pos)" f)
(write-line "(while (setq pos (vl-string-search delim str))" f)
(write-line " (if (> pos 0) (setq lst (cons (substr str 1 pos) lst)))" f)
(write-line " (setq str (substr str (+ 2 pos))))" f)
(write-line "(if (/= str \"\") (setq lst (cons str lst))) (reverse lst))" f)
(write-line "(defun process-layout (doc lay lay-name cfg-block cfg-printer cfg-style cfg-media cfg-scale-mode cfg-factor /" f)
(write-line " ss elist obj name minpt maxpt bdlist pW pH paperW i plot-bd scale frame-w target-list)" f)
(write-line "(princ (strcat \"\\n[\" lay-name \"]\"))" f)
(write-line "(if (vl-string-search \";\" cfg-block)" f)
(write-line " (setq target-list (mapcar 'strcase (str-split cfg-block \";\")))" f)
(write-line " (setq target-list (mapcar 'strcase (str-split cfg-block \" \"))))" f)
(write-line "(if (null target-list) (setq target-list (list (strcase cfg-block))))" f)
(write-line "(vla-ZoomExtents (vlax-get-acad-object))" f)
(write-line "(setq ss (ssget \"X\" (list '(0 . \"INSERT\") (cons 410 lay-name))))" f)
(write-line "(if ss (progn" f)
(write-line " (setq elist (ss->list ss) bdlist '())" f)
(write-line " (foreach ent elist" f)
(write-line " (setq obj (vlax-ename->vla-object ent))" f)
(write-line " (setq name (if (vlax-property-available-p obj 'EffectiveName) (vla-get-EffectiveName obj) (vla-get-Name obj)))" f)
(write-line " (if (member (strcase name) target-list)" f)
(write-line " (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-GetBoundingBox (list obj 'minpt 'maxpt))))" f)
(write-line " (setq minpt (vlax-safearray->list minpt) maxpt (vlax-safearray->list maxpt)" f)
(write-line " bdlist (cons (list (list (car minpt) (cadr minpt)) (list (car maxpt) (cadr maxpt))) bdlist)))))))" f)
(write-line "(if bdlist (progn" f)
(write-line " (setq bdlist (sort-frames bdlist))" f)
(write-line " (princ (strcat \" 找到\" (itoa (length bdlist)) \"个图框\"))" f)
(write-line " (vl-catch-all-apply 'vla-put-ActiveLayout (list doc lay))" f)
(write-line " (vla-RefreshPlotDeviceInfo lay)" f)
(write-line " (vl-catch-all-apply 'vla-put-ConfigName (list lay cfg-printer))" f)
(write-line " (vla-RefreshPlotDeviceInfo lay)" f)
(write-line " (vl-catch-all-apply 'vla-put-CanonicalMediaName (list lay cfg-media))" f)
(write-line " (if (/= cfg-style \"\") (vl-catch-all-apply 'vla-put-StyleSheet (list lay cfg-style)))" f)
(write-line " (vla-put-PaperUnits lay 1)" f)
(write-line " (vla-GetPaperSize lay 'pW 'pH)" f)
(write-line " (setq paperW (max pW pH) i 0)" f)
(write-line " (foreach bd bdlist" f)
(write-line " (setq i (1+ i))" f)
(write-line " (princ (strcat \"\\n打印[\" (itoa i) \"/\" (itoa (length bdlist)) \"]\"))" f)
(write-line " (if (and (= cfg-scale-mode \"ScaleToFit\") (/= cfg-factor 1.0))" f)
(write-line " (setq plot-bd (shrink-bounding bd cfg-factor)) (setq plot-bd bd))" f)
(write-line " (if (= (islandscape bd) (> pW pH)) (vla-put-PlotRotation lay 0) (vla-put-PlotRotation lay 1))" f)
(write-line " (vla-SetWindowToPlot lay (ax:2dpoint (car plot-bd)) (ax:2dpoint (cadr plot-bd)))" f)
(write-line " (vla-put-PlotType lay 4) (vla-put-CenterPlot lay :vlax-true)" f)
(write-line " (cond" f)
(write-line " ((= cfg-scale-mode \"ScaleToFit\") (vla-put-UseStandardScale lay :vlax-true) (vla-put-StandardScale lay 0))" f)
(write-line " ((= cfg-scale-mode \"1:1\") (vla-put-UseStandardScale lay :vlax-false) (vla-SetCustomScale lay 1.0 1.0))" f)
(write-line " ((= cfg-scale-mode \"Auto\") (setq frame-w (getwidth bd) scale (fixscale (/ frame-w paperW)))" f)
(write-line " (vla-put-UseStandardScale lay :vlax-false) (vla-SetCustomScale lay 1.0 scale)))" f)
(write-line " (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-PlotToDevice (list (vla-get-Plot doc))))" f)
(write-line " (princ \" X\") (princ \" OK\"))))" f)
(write-line " (princ \" 无匹配图框\")))" f)
(write-line "(defun c:AutoRunBatchPlot (/ acad doc layouts lay layout-list)" f)
(write-line "(vl-load-com)" f)
(write-line "(setq acad (vlax-get-acad-object) doc (vla-get-ActiveDocument acad) layouts (vla-get-Layouts doc))" f)
(write-line "(setvar \"BACKGROUNDPLOT\" 0)" f)
(write-line (strcat "(setq cfg-block \"" block "\" cfg-printer \"" printer "\" cfg-style \"" style "\")") f)
(write-line (strcat "(setq cfg-media \"" media "\" cfg-scale-mode \"" scale-mode "\" cfg-factor " (rtos factor 2 6) ")") f)
(write-line "(process-layout doc (vla-Item layouts \"Model\") \"Model\" cfg-block cfg-printer cfg-style cfg-media cfg-scale-mode cfg-factor)" f)
(write-line "(setq layout-list '())" f)
(write-line "(vlax-for lay layouts (if (/= (vla-get-Name lay) \"Model\") (setq layout-list (cons lay layout-list))))" f)
(write-line "(setq layout-list (vl-sort layout-list '(lambda (a b) (< (vla-get-TabOrder a) (vla-get-TabOrder b)))))" f)
(write-line "(foreach lay layout-list (process-layout doc lay (vla-get-Name lay) cfg-block cfg-printer cfg-style cfg-media cfg-scale-mode cfg-factor))" f)
(write-line "(princ \"\\n--- 当前文件完成 ---\") (princ))" f)
(write-line "(c:AutoRunBatchPlot)" f)
(close f)
filepath
)
nil
)
)
;; ========== 生成 SCR ==========
(defun generate-scr-file (scr-path worker-path temp-dir file-list / f file full-path fname)
(setq worker-path (path-slash worker-path))
(if file-list
(progn
(setq f (open scr-path "w"))
(if f
(progn
(write-line "SDI 0" f)
(write-line "SECURELOAD 0" f)
(write-line "FILEDIA 0" f)
(write-line "CMDECHO 0" f)
(write-line "XREFNOTIFY 0" f)
(write-line "PROXYNOTICE 0" f)
(foreach file file-list
(setq fname (vl-filename-base file))
(setq full-path (strcat temp-dir "\\" fname ".dwg"))
(setq full-path (path-slash full-path))
(write-line (strcat "_.OPEN \"" full-path "\"") f)
(write-line "DELAY 100" f)
(write-line (strcat "(if (findfile \"" worker-path "\") (load \"" worker-path "\"))") f)
(write-line "DELAY 50" f)
(write-line "_.CLOSE _N" f)
)
(write-line "FILEDIA 1" f)
(write-line "CMDECHO 1" f)
(write-line "SECURELOAD 1" f)
(write-line "(princ \"\\n==============================\")" f)
(write-line "(princ \"\\n批量打印全部完成!\")" f)
(write-line "(princ \"\\n==============================\")" f)
(write-line "(princ)" f)
(close f)
T
)
nil
)
)
nil
)
)
;; ========== DCL 界面 ==========
(defun write-dcl (filename / f)
(setq f (open filename "w"))
(if f
(progn
(write-line "batchplot : dialog {" f)
(write-line "label = \"批量打印 V1.0\";" f)
(write-line ": row {" f)
;; 左侧 - 文件列表
(write-line " : boxed_column {" f)
(write-line " label = \"待打印文件\";" f)
(write-line " : row {" f)
(write-line " : edit_box {" f)
(write-line " key = \"txt_path\";" f)
(write-line " width = 30;" f)
(write-line " edit_limit = 512;" f)
(write-line " }" f)
(write-line " : button { label = \"...\"; key = \"btn_browse\"; width = 3; fixed_width = true; }" f)
(write-line " }" f)
(write-line " : row {" f)
(write-line " : button { label = \"加载路径\"; key = \"btn_load\"; width = 10; }" f)
(write-line " : button { label = \"添加文件\"; key = \"btn_add\"; width = 10; }" f)
(write-line " : button { label = \"清空\"; key = \"btn_clear\"; width = 6; }" f)
(write-line " }" f)
(write-line " : list_box {" f)
(write-line " key = \"lst_files\";" f)
(write-line " width = 36;" f)
(write-line " height = 15;" f)
(write-line " multiple_select = false;" f)
(write-line " }" f)
(write-line " : row {" f)
(write-line " : text { key = \"txt_count\"; label = \"共 0 个文件\"; width = 16; }" f)
(write-line " : button { label = \"删除选中\"; key = \"btn_remove\"; width = 10; }" f)
(write-line " }" f)
(write-line " }" f)
;; 右侧 - 打印设置
(write-line " : column {" f)
(write-line " : boxed_column {" f)
(write-line " label = \"图框设置\";" f)
(write-line " : row {" f)
(write-line " : edit_box { label = \"块名:\"; key = \"txt_block\"; width = 22; }" f)
(write-line " : button { label = \"拾取\"; key = \"btn_pick\"; width = 6; }" f)
(write-line " }" f)
(write-line " : text { label = \"多个块名用分号;分隔\"; }" f)
(write-line " }" f)
(write-line " : boxed_column {" f)
(write-line " label = \"打印机设置\";" f)
(write-line " : popup_list { label = \"打印机:\"; key = \"pop_printer\"; width = 32; }" f)
(write-line " : popup_list { label = \"样式表:\"; key = \"pop_style\"; width = 32; }" f)
(write-line " : popup_list { label = \"纸张:\"; key = \"pop_media\"; width = 32; }" f)
(write-line " }" f)
(write-line " : boxed_column {" f)
(write-line " label = \"比例设置\";" f)
(write-line " : popup_list { label = \"比例:\"; key = \"pop_scale\"; width = 18; }" f)
(write-line " : edit_box { label = \"放大系数:\"; key = \"txt_factor\"; width = 12; }" f)
(write-line " : text { label = \"(放大系数仅布满图纸时有效)\"; }" f)
(write-line " }" f)
(write-line " : boxed_column {" f)
(write-line " label = \"使用说明\";" f)
(write-line " : text { label = \"1. 路径栏可粘贴文件夹或DWG路径\"; }" f)
(write-line " : text { label = \"2. 点击[加载路径]导入文件\"; }" f)
(write-line " : text { label = \"3. 选中列表项可查看完整路径\"; }" f)
(write-line " }" f)
(write-line " }" f)
(write-line "}" f)
(write-line "spacer_1;" f)
(write-line "ok_cancel;" f)
(write-line "}" f)
(close f)
T
)
nil
)
)
;; ========== 主逻辑 ==========
(load-settings)
(setq plotters (get-plotters))
(setq styles (get-styles))
(setq dcl-file (vl-filename-mktemp "bp_scr" nil ".dcl"))
(write-dcl dcl-file)
(setq dcl-id (load_dialog dcl-file))
(setq loop T)
(if (valid-folder-p sel-folder)
(progn
(load-folder-files sel-folder)
(setq input-path sel-folder)
)
)
(while loop
(if (not (new_dialog "batchplot" dcl-id))
(setq loop nil)
(progn
(start_list "pop_printer") (mapcar 'add_list plotters) (end_list)
(start_list "pop_style") (mapcar 'add_list styles) (end_list)
(start_list "pop_scale")
(add_list "布满图纸")
(add_list "自动比例")
(add_list "1:1")
(end_list)
(update-file-list-display)
(if (and input-path (/= input-path ""))
(set_tile "txt_path" input-path)
(if sel-folder (set_tile "txt_path" sel-folder))
)
(cond
((= sel-scale "ScaleToFit") (set_tile "pop_scale" "0"))
((= sel-scale "Auto") (set_tile "pop_scale" "1"))
((= sel-scale "1:1") (set_tile "pop_scale" "2"))
(T (set_tile "pop_scale" "0") (setq sel-scale "ScaleToFit"))
)
(update-factor-state sel-scale)
(if sel-block (set_tile "txt_block" sel-block))
(set_tile "txt_factor" (if sel-factor sel-factor "1.0"))
(if (and sel-plotter (member sel-plotter plotters))
(set_tile "pop_printer" (itoa (vl-position sel-plotter plotters)))
)
(if (and sel-style (member sel-style styles))
(set_tile "pop_style" (itoa (vl-position sel-style styles)))
)
(defun update-media-list (idx)
(if (and plotters (< (atoi idx) (length plotters)))
(progn
(setq sel-plotter (nth (atoi idx) plotters))
(setq media-list (get-media-names sel-plotter))
(start_list "pop_media")
(if media-list
(mapcar 'add_list media-list)
(add_list "无可用纸张")
)
(end_list)
(if (and media-list sel-media (member sel-media media-list))
(set_tile "pop_media" (itoa (vl-position sel-media media-list)))
(if media-list (setq sel-media (car media-list)))
)
)
)
)
(update-media-list
(if (and sel-plotter (member sel-plotter plotters))
(itoa (vl-position sel-plotter plotters))
"0"
)
)
(action_tile "btn_pick" "(done_dialog 2)")
(action_tile "btn_browse" "(done_dialog 3)")
(action_tile "btn_load" "(done_dialog 7)")
(action_tile "btn_add" "(done_dialog 4)")
(action_tile "btn_remove" "(done_dialog 5)")
(action_tile "btn_clear" "(done_dialog 6)")
(action_tile "lst_files"
"(progn (setq selected-file-idx (atoi $value)) (update-path-display selected-file-idx))"
)
(action_tile "txt_path" "(setq input-path $value)")
(action_tile "pop_printer" "(update-media-list $value)")
(action_tile "pop_style" "(setq sel-style (nth (atoi $value) styles))")
(action_tile "pop_media" "(if media-list (setq sel-media (nth (atoi $value) media-list)))")
(action_tile "txt_block" "(setq sel-block $value)")
(action_tile "txt_factor" "(setq sel-factor $value)")
(action_tile "pop_scale"
(strcat
"(cond ((= $value \"0\") (setq sel-scale \"ScaleToFit\"))"
" ((= $value \"1\") (setq sel-scale \"Auto\"))"
" ((= $value \"2\") (setq sel-scale \"1:1\")))"
"(update-factor-state sel-scale)"
)
)
(action_tile "accept" "(setq input-path (get_tile \"txt_path\"))(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq result (start_dialog))
(cond
((= result 1)
(setq loop nil)
(if (null sel-scale) (setq sel-scale "ScaleToFit"))
(save-settings)
(if (and file-list
(> (length file-list) 0)
sel-block (/= sel-block "")
sel-media)
(progn
(setq temp-dir "C:\\BatchPlotTemp")
(princ "\n======================================")
(princ "\n[批量打印 V1.0] 准备中...")
(princ (strcat "\n文件数: " (itoa (length file-list))))
(princ (strcat "\n图框: " sel-block))
(princ (strcat "\n比例: " sel-scale))
(princ "\n======================================")
(if (prepare-temp-env file-list temp-dir)
(progn
(setq worker-path (strcat temp-dir "\\BP_Worker.lsp"))
(setq scr-path (strcat temp-dir "\\BP_Job.scr"))
(setq factor-num (atof sel-factor))
(if (or (= factor-num 0.0) (< factor-num 0.1))
(setq factor-num 1.0)
)
(princ "\n生成Worker...")
(if (generate-worker-lsp worker-path sel-block sel-plotter sel-style sel-media sel-scale factor-num)
(progn
(princ " OK")
(princ "\n生成脚本...")
(if (generate-scr-file scr-path worker-path temp-dir file-list)
(progn
(princ " OK")
(unload_dialog dcl-id)
(setq dcl-id nil)
(princ "\n启动打印...")
(command "_.SCRIPT" scr-path)
)
(alert "脚本生成失败!")
)
)
(alert "Worker生成失败!")
)
)
(alert "准备临时环境失败!\n请检查磁盘空间和权限。")
)
)
(alert "请检查:\n- 文件列表不能为空\n- 必须填写图框块名\n- 必须选择纸张")
)
)
((= result 2)
(setq temp (pick-block))
(if (and temp (/= temp ""))
(if (and sel-block (/= sel-block ""))
(setq sel-block (strcat sel-block ";" temp))
(setq sel-block temp)
)
)
)
((= result 3)
(setq temp (browse-folder "选择DWG文件夹"))
(if temp
(setq input-path temp)
)
)
((= result 4)
(setq temp (browse-single-file))
(if temp
(progn
(if (add-file-to-list temp)
(progn
(setq input-path temp)
(princ (strcat "\n已添加: " (vl-filename-base temp)))
)
(princ "\n文件已存在或无效")
)
)
)
)
((= result 5)
(if (and selected-file-idx (>= selected-file-idx 0) (< selected-file-idx (length file-list)))
(progn
(princ (strcat "\n已删除: " (vl-filename-base (nth selected-file-idx file-list))))
(remove-selected-file selected-file-idx)
(setq selected-file-idx nil)
)
(alert "请先选择要删除的文件")
)
)
((= result 6)
(setq file-list nil)
(setq selected-file-idx nil)
(setq input-path "")
(princ "\n文件列表已清空")
)
((= result 7)
(load-from-input-path input-path)
)
((= result 0) (setq loop nil))
)
)
)
)
(if dcl-id (unload_dialog dcl-id))
(if (and dcl-file (findfile dcl-file)) (vl-file-delete dcl-file))
(princ)
)
用到了SCR 函数。会在c盘创建临时的文件夹，打印的cad文档会复制到临时文件。每次启动会检查若存在临时文件则删除重新创建，避免错误！
cad2008错误: 输入中的点位置不正确。 建议再加个设置透明度打印，第二个纸图幅大小根据文件自动判断 xsmabbs 发表于 2025-11-30 21:25
2016版本提示错误: 输入中的点位置不正确ai越来越火了
我用的是cad2024没有问题。
代码修复了，测试的cad2008和cad2024.其他版本cad没有，没有测试。
注意：cad2008，保存为.lsp时，要保存为 ANSI 格式
ai分析的：
主要修改点
位置 修改内容 目的
generate-scr-file 使用 (setvar ...) 替代命令行方式 更可靠的变量设置
generate-scr-file 添加 (if (getvar "SECURELOAD") ...) CAD 2008无此变量
generate-scr-file 添加 DEMANDLOAD 条件设置 防止按需加载干扰
generate-scr-file DELAY 增加到 300/100 CAD 2008 响应较慢
generate-worker-lsp BACKGROUNDPLOT 条件检测 兼容旧版本
版本号 V1.0 → V1.1 标识修复版本
(defun c:BPLOT (/ *error* dcl-file dcl-id result
get-plotters get-styles get-media-names
update-media-list update-file-list write-dcl browse-folder
valid-folder-p save-settings load-settings
generate-worker-lsp generate-scr-file
smart-sort path-slash prepare-temp-env
remove-selected-file browse-single-file
plotters styles media-list pick-block
sel-block sel-plotter sel-style sel-media sel-scale sel-factor
sel-folder file-list selected-file-idx
acad-obj doc clayout reg-path factor-num
worker-path scr-path temp loop temp-dir input-path)
(vl-load-com)
(setq acad-obj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acad-obj))
(setq clayout (vla-get-ActiveLayout doc))
(setq reg-path "HKEY_CURRENT_USER\\Software\\BatchPlotTool_SCR")
(setq file-list nil)
(setq selected-file-idx nil)
(setq input-path "")
(defun *error* (msg)
(if dcl-id (unload_dialog dcl-id))
(if (and dcl-file (findfile dcl-file)) (vl-file-delete dcl-file))
(if (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*")))
(princ (strcat "\n错误: " msg))
)
(princ)
)
(defun path-slash (path)
(while (vl-string-search "\\" path)
(setq path (vl-string-subst "/" "\\" path))
)
path
)
(defun extract-number (s / i len c num found)
(setq i 1 len (strlen s) num "" found nil)
(while (and (<= i len) (not (wcmatch (substr s i 1) "#")))
(setq i (1+ i))
)
(while (and (<= i len) (wcmatch (setq c (substr s i 1)) "#"))
(setq num (strcat num c) i (1+ i) found T)
)
(if found (atoi num) 999999)
)
(defun smart-sort (lst)
(vl-sort lst
(function (lambda (a b / na nb)
(setq na (extract-number a) nb (extract-number b))
(if (= na nb) (< a b) (< na nb))
))
)
)
(defun smart-sort-paths (lst)
(vl-sort lst
(function (lambda (a b / na nb)
(setq na (extract-number (vl-filename-base a)))
(setq nb (extract-number (vl-filename-base b)))
(if (= na nb)
(< (strcase (vl-filename-base a)) (strcase (vl-filename-base b)))
(< na nb)
)
))
)
)
(defun prepare-temp-env (file-list temp-dir / fso src-path temp-path file-obj attrs copied-count fname)
(setq fso (vlax-create-object "Scripting.FileSystemObject"))
(if (vlax-invoke fso 'FolderExists temp-dir)
(vl-catch-all-apply 'vlax-invoke (list fso 'DeleteFolder temp-dir :vlax-true))
)
(vl-mkdir temp-dir)
(setq copied-count 0)
(if file-list
(progn
(princ "\n[系统] 正在初始化临时环境...")
(foreach src-path file-list
(setq fname (vl-filename-base src-path))
(setq temp-path (strcat temp-dir "\\" fname ".dwg"))
(if (vl-file-copy src-path temp-path)
(progn
(setq file-obj (vl-catch-all-apply 'vlax-invoke (list fso 'GetFile temp-path)))
(if (and file-obj (not (vl-catch-all-error-p file-obj)))
(progn
(setq attrs (vlax-get file-obj 'Attributes))
(if (= (logand attrs 1) 1)
(vlax-put file-obj 'Attributes (logand attrs 65534))
)
(vlax-release-object file-obj)
)
)
(setq copied-count (1+ copied-count))
(princ (strcat "\n-> 副本就绪: " fname ".dwg"))
)
)
)
)
)
(if fso (vlax-release-object fso))
(> copied-count 0)
)
(defun get-plotters ()
(vla-RefreshPlotDeviceInfo clayout)
(vlax-safearray->list (vlax-variant-value (vla-GetPlotDeviceNames clayout)))
)
(defun get-styles ()
(vla-RefreshPlotDeviceInfo clayout)
(vlax-safearray->list (vlax-variant-value (vla-GetPlotStyleTableNames clayout)))
)
(defun get-media-names (plotter / media err)
(setq media nil)
(if (and plotter (/= plotter ""))
(progn
(setq err (vl-catch-all-apply 'vla-put-ConfigName (list clayout plotter)))
(if (not (vl-catch-all-error-p err))
(progn
(vla-RefreshPlotDeviceInfo clayout)
(setq media (vl-catch-all-apply
(function (lambda ()
(vlax-safearray->list (vlax-variant-value (vla-GetCanonicalMediaNames clayout)))
))
nil
))
(if (vl-catch-all-error-p media) (setq media nil))
)
)
)
)
media
)
(defun browse-folder (msg / sh folder folderobj path)
(setq path nil)
(setq sh (vla-getInterfaceObject acad-obj "Shell.Application"))
(if sh
(progn
(setq folder (vl-catch-all-apply 'vlax-invoke-method (list sh 'BrowseForFolder 0 msg 0)))
(if (and folder (not (vl-catch-all-error-p folder)))
(progn
(setq folderobj (vlax-get-property folder 'Self))
(setq path (vlax-get-property folderobj 'Path))
(vlax-release-object folderobj)
(vlax-release-object folder)
)
)
(vlax-release-object sh)
)
)
(if (and path (> (strlen path) 0))
(if (/= (substr path (strlen path) 1) "\\")
(setq path (strcat path "\\"))
)
)
path
)
(defun browse-single-file ()
(getfiled "选择DWG文件" "" "dwg" 4)
)
(defun valid-folder-p (folder)
(and folder (= (type folder) 'STR) (> (strlen folder) 0))
)
(defun pick-block (/ ent obj name)
(setq name nil)
(princ "\n选择图框块...")
(while (null name)
(setq ent (car (entsel "\n点击选择图框块: ")))
(if ent
(progn
(setq obj (vlax-ename->vla-object ent))
(if (= (vla-get-ObjectName obj) "AcDbBlockReference")
(if (vlax-property-available-p obj 'EffectiveName)
(setq name (vla-get-EffectiveName obj))
(setq name (vla-get-Name obj))
)
(princ "\n不是块引用")
)
)
(setq name "")
)
)
name
)
(defun save-settings ()
(vl-registry-write reg-path "Block" (if sel-block sel-block ""))
(vl-registry-write reg-path "Printer" (if sel-plotter sel-plotter ""))
(vl-registry-write reg-path "Style" (if sel-style sel-style ""))
(vl-registry-write reg-path "Media" (if sel-media sel-media ""))
(vl-registry-write reg-path "Scale" (if sel-scale sel-scale "ScaleToFit"))
(vl-registry-write reg-path "Factor" (if sel-factor sel-factor "1.0"))
(vl-registry-write reg-path "Folder" (if sel-folder sel-folder ""))
)
(defun load-settings ()
(setq sel-block (vl-registry-read reg-path "Block"))
(setq sel-plotter (vl-registry-read reg-path "Printer"))
(setq sel-style (vl-registry-read reg-path "Style"))
(setq sel-media (vl-registry-read reg-path "Media"))
(setq sel-scale (vl-registry-read reg-path "Scale"))
(setq sel-factor (vl-registry-read reg-path "Factor"))
(setq sel-folder (vl-registry-read reg-path "Folder"))
(if (or (not sel-scale) (= sel-scale "")) (setq sel-scale "ScaleToFit"))
(if (or (not sel-factor) (= sel-factor "")) (setq sel-factor "1.0"))
)
(defun load-folder-files (folder / files full-path)
(if (valid-folder-p folder)
(progn
(if (= (substr folder (strlen folder) 1) "\\")
(setq folder (substr folder 1 (1- (strlen folder))))
)
(setq files (vl-directory-files folder "*.dwg" 1))
(setq files (smart-sort files))
(setq file-list nil)
(foreach f files
(setq full-path (strcat folder "\\" f))
(setq file-list (append file-list (list full-path)))
)
)
)
file-list
)
(defun update-file-list-display ()
(start_list "lst_files")
(if file-list
(foreach f file-list
(add_list (strcat (vl-filename-base f) ".dwg"))
)
(add_list "(空)")
)
(end_list)
(set_tile "txt_count" (strcat "共 " (itoa (length file-list)) " 个文件"))
)
(defun update-path-display (idx)
(if (and file-list idx (>= idx 0) (< idx (length file-list)))
(progn
(setq input-path (nth idx file-list))
(set_tile "txt_path" input-path)
)
)
)
(defun remove-selected-file (idx / i new-list)
(if (and idx (>= idx 0) (< idx (length file-list)))
(progn
(setq i 0 new-list nil)
(foreach f file-list
(if (/= i idx)
(setq new-list (append new-list (list f)))
)
(setq i (1+ i))
)
(setq file-list new-list)
)
)
)
(defun add-file-to-list (filepath)
(if (and filepath
(findfile filepath)
(wcmatch (strcase filepath) "*.DWG")
(not (member filepath file-list)))
(progn
(setq file-list (append file-list (list filepath)))
(setq file-list (smart-sort-paths file-list))
T
)
nil
)
)
(defun load-from-input-path (path / clean-path)
(if (and path (/= path ""))
(progn
(setq clean-path (vl-string-trim " \t" path))
(if (= (substr clean-path (strlen clean-path) 1) "\\")
(setq clean-path (substr clean-path 1 (1- (strlen clean-path))))
)
(cond
((and (wcmatch (strcase clean-path) "*.DWG") (findfile clean-path))
(if (add-file-to-list clean-path)
(progn (princ (strcat "\n已添加文件: " (vl-filename-base clean-path))) T)
(progn (princ "\n文件已存在或无效") nil)
)
)
((vl-file-directory-p clean-path)
(setq sel-folder (strcat clean-path "\\"))
(load-folder-files sel-folder)
(if file-list
(progn (princ (strcat "\n已从文件夹加载 " (itoa (length file-list)) " 个文件")) T)
(progn (princ "\n文件夹中没有DWG文件") nil)
)
)
(T (alert (strcat "无效路径:\n" clean-path)) nil)
)
)
nil
)
)
(defun update-factor-state (scale-mode)
(if (= scale-mode "ScaleToFit")
(mode_tile "txt_factor" 0)
(mode_tile "txt_factor" 1)
)
)
(defun generate-worker-lsp (filepath block printer style media scale-mode factor / f)
(setq f (open filepath "w"))
(if f
(progn
(write-line ";; BatchPlot Worker V1.1" f)
(write-line "(princ \"\\n 加载中...\")" f)
(write-line "" f)
(write-line "(defun ss->list (ss / n lst)" f)
(write-line "(if ss (repeat (setq n (sslength ss)) (setq lst (cons (ssname ss (setq n (1- n))) lst)))) lst)" f)
(write-line "" f)
(write-line "(defun ax:2dpoint (pt / arr)" f)
(write-line "(setq arr (vlax-make-safearray vlax-vbdouble (cons 0 1)))" f)
(write-line "(vlax-safearray-put-element arr 0 (float (car pt)))" f)
(write-line "(vlax-safearray-put-element arr 1 (float (cadr pt)))" f)
(write-line "(vlax-make-variant arr))" f)
(write-line "" f)
(write-line "(defun shrink-bounding (bd factor / ll ur cx cy hw hh)" f)
(write-line "(setq ll (car bd) ur (cadr bd))" f)
(write-line "(setq cx (/ (+ (car ll) (car ur)) 2.0))" f)
(write-line "(setq cy (/ (+ (cadr ll) (cadr ur)) 2.0))" f)
(write-line "(setq hw (/ (- (car ur) (car ll)) 2.0 factor))" f)
(write-line "(setq hh (/ (- (cadr ur) (cadr ll)) 2.0 factor))" f)
(write-line "(list (list (- cx hw) (- cy hh)) (list (+ cx hw) (+ cy hh))))" f)
(write-line "" f)
(write-line "(defun islandscape (bd)" f)
(write-line "(> (abs (- (caadr bd) (caar bd))) (abs (- (cadadr bd) (cadar bd)))))" f)
(write-line "" f)
(write-line "(defun getwidth (bd)" f)
(write-line "(max (abs (- (caadr bd) (caar bd))) (abs (- (cadadr bd) (cadar bd)))))" f)
(write-line "" f)
(write-line "(defun fixscale (n / i large)" f)
(write-line "(setq i 0 large (> n 100))" f)
(write-line "(while (or (> n 100) (< n 10))" f)
(write-line " (if large (setq n (/ n 10.0)) (setq n (* n 10.0)))" f)
(write-line " (setq i (1+ i)))" f)
(write-line "(setq n (fix (+ 0.5 n)))" f)
(write-line "(repeat i (if large (setq n (* n 10.0)) (setq n (/ n 10.0)))) n)" f)
(write-line "" f)
(write-line "(defun sort-frames (bdlist / fuzz)" f)
(write-line "(setq fuzz 10.0)" f)
(write-line "(vl-sort bdlist" f)
(write-line " (function (lambda (a b)" f)
(write-line " (if (equal (caar a) (caar b) fuzz)" f)
(write-line " (> (cadar a) (cadar b))" f)
(write-line " (< (caar a) (caar b)))))))" f)
(write-line "" f)
(write-line "(defun str-split (str delim / lst pos)" f)
(write-line "(while (setq pos (vl-string-search delim str))" f)
(write-line " (if (> pos 0) (setq lst (cons (substr str 1 pos) lst)))" f)
(write-line " (setq str (substr str (+ 2 pos))))" f)
(write-line "(if (/= str \"\") (setq lst (cons str lst)))" f)
(write-line "(reverse lst))" f)
(write-line "" f)
(write-line "(defun process-layout (doc lay lay-name cfg-block cfg-printer cfg-style cfg-media cfg-scale-mode cfg-factor /" f)
(write-line " ss elist obj name minpt maxpt bdlist pW pH paperW i plot-bd scale frame-w target-list)" f)
(write-line "(princ (strcat \"\\n[\" lay-name \"]\"))" f)
(write-line "(if (vl-string-search \";\" cfg-block)" f)
(write-line " (setq target-list (mapcar (function strcase) (str-split cfg-block \";\")))" f)
(write-line " (setq target-list (list (strcase cfg-block))))" f)
(write-line "(vla-ZoomExtents (vlax-get-acad-object))" f)
(write-line "(setq ss (ssget \"X\" (list (cons 0 \"INSERT\") (cons 410 lay-name))))" f)
(write-line "(if ss" f)
(write-line " (progn" f)
(write-line " (setq elist (ss->list ss) bdlist nil)" f)
(write-line " (foreach ent elist" f)
(write-line " (setq obj (vlax-ename->vla-object ent))" f)
(write-line " (setq name (if (vlax-property-available-p obj 'EffectiveName)" f)
(write-line " (vla-get-EffectiveName obj) (vla-get-Name obj)))" f)
(write-line " (if (member (strcase name) target-list)" f)
(write-line " (if (not (vl-catch-all-error-p" f)
(write-line " (vl-catch-all-apply 'vla-GetBoundingBox (list obj 'minpt 'maxpt))))" f)
(write-line " (progn" f)
(write-line " (setq minpt (vlax-safearray->list minpt))" f)
(write-line " (setq maxpt (vlax-safearray->list maxpt))" f)
(write-line " (setq bdlist (cons (list (list (car minpt) (cadr minpt))" f)
(write-line " (list (car maxpt) (cadr maxpt))) bdlist))))))))" f)
(write-line "(if bdlist" f)
(write-line " (progn" f)
(write-line " (setq bdlist (sort-frames bdlist))" f)
(write-line " (princ (strcat \" 找到 \" (itoa (length bdlist)) \" 个图框\"))" f)
(write-line " (vl-catch-all-apply 'vla-put-ActiveLayout (list doc lay))" f)
(write-line " (vla-RefreshPlotDeviceInfo lay)" f)
(write-line " (vl-catch-all-apply 'vla-put-ConfigName (list lay cfg-printer))" f)
(write-line " (vla-RefreshPlotDeviceInfo lay)" f)
(write-line " (vl-catch-all-apply 'vla-put-CanonicalMediaName (list lay cfg-media))" f)
(write-line " (if (/= cfg-style \"\")" f)
(write-line " (vl-catch-all-apply 'vla-put-StyleSheet (list lay cfg-style)))" f)
(write-line " (vla-put-PaperUnits lay 1)" f)
(write-line " (vla-GetPaperSize lay 'pW 'pH)" f)
(write-line " (setq paperW (max pW pH) i 0)" f)
(write-line " (foreach bd bdlist" f)
(write-line " (setq i (1+ i))" f)
(write-line " (princ (strcat \"\\n打印[\" (itoa i) \"/\" (itoa (length bdlist)) \"]\"))" f)
(write-line " (if (and (= cfg-scale-mode \"ScaleToFit\") (/= cfg-factor 1.0))" f)
(write-line " (setq plot-bd (shrink-bounding bd cfg-factor))" f)
(write-line " (setq plot-bd bd))" f)
(write-line " (if (= (islandscape bd) (> pW pH))" f)
(write-line " (vla-put-PlotRotation lay 0)" f)
(write-line " (vla-put-PlotRotation lay 1))" f)
(write-line " (vla-SetWindowToPlot lay (ax:2dpoint (car plot-bd)) (ax:2dpoint (cadr plot-bd)))" f)
(write-line " (vla-put-PlotType lay 4)" f)
(write-line " (vla-put-CenterPlot lay :vlax-true)" f)
(write-line " (cond" f)
(write-line " ((= cfg-scale-mode \"ScaleToFit\")" f)
(write-line " (vla-put-UseStandardScale lay :vlax-true)" f)
(write-line " (vla-put-StandardScale lay 0))" f)
(write-line " ((= cfg-scale-mode \"1:1\")" f)
(write-line " (vla-put-UseStandardScale lay :vlax-false)" f)
(write-line " (vla-SetCustomScale lay 1.0 1.0))" f)
(write-line " ((= cfg-scale-mode \"Auto\")" f)
(write-line " (setq frame-w (getwidth bd))" f)
(write-line " (setq scale (fixscale (/ frame-w paperW)))" f)
(write-line " (vla-put-UseStandardScale lay :vlax-false)" f)
(write-line " (vla-SetCustomScale lay 1.0 scale)))" f)
(write-line " (if (vl-catch-all-error-p" f)
(write-line " (vl-catch-all-apply 'vla-PlotToDevice (list (vla-get-Plot doc))))" f)
(write-line " (princ \" X\")" f)
(write-line " (princ \" OK\"))))" f)
(write-line " (princ \" 无匹配图框\")))" f)
(write-line "" f)
(write-line "(defun c:AutoRunBatchPlot (/ acad doc layouts lay layout-list)" f)
(write-line "(vl-load-com)" f)
(write-line "(setq acad (vlax-get-acad-object))" f)
(write-line "(setq doc (vla-get-ActiveDocument acad))" f)
(write-line "(setq layouts (vla-get-Layouts doc))" f)
(write-line "(if (getvar \"BACKGROUNDPLOT\") (setvar \"BACKGROUNDPLOT\" 0))" f)
(write-line (strcat "(setq cfg-block \"" block "\")") f)
(write-line (strcat "(setq cfg-printer \"" printer "\")") f)
(write-line (strcat "(setq cfg-style \"" style "\")") f)
(write-line (strcat "(setq cfg-media \"" media "\")") f)
(write-line (strcat "(setq cfg-scale-mode \"" scale-mode "\")") f)
(write-line (strcat "(setq cfg-factor " (rtos factor 2 6) ")") f)
(write-line "(process-layout doc (vla-Item layouts \"Model\") \"Model\"" f)
(write-line " cfg-block cfg-printer cfg-style cfg-media cfg-scale-mode cfg-factor)" f)
(write-line "(setq layout-list nil)" f)
(write-line "(vlax-for lay layouts" f)
(write-line " (if (/= (vla-get-Name lay) \"Model\")" f)
(write-line " (setq layout-list (cons lay layout-list))))" f)
(write-line "(setq layout-list (vl-sort layout-list" f)
(write-line " (function (lambda (a b) (< (vla-get-TabOrder a) (vla-get-TabOrder b))))))" f)
(write-line "(foreach lay layout-list" f)
(write-line " (process-layout doc lay (vla-get-Name lay)" f)
(write-line " cfg-block cfg-printer cfg-style cfg-media cfg-scale-mode cfg-factor))" f)
(write-line "(princ \"\\n--- 当前文件完成 ---\")" f)
(write-line "(princ))" f)
(write-line "" f)
(write-line "(c:AutoRunBatchPlot)" f)
(close f)
filepath
)
nil
)
)
(defun generate-scr-file (scr-path worker-path temp-dir file-list / f fname full-path)
(setq worker-path (path-slash worker-path))
(if file-list
(progn
(setq f (open scr-path "w"))
(if f
(progn
(write-line "(setvar \"SDI\" 0)" f)
(write-line "(setvar \"FILEDIA\" 0)" f)
(write-line "(setvar \"CMDECHO\" 0)" f)
(write-line "(if (getvar \"SECURELOAD\") (setvar \"SECURELOAD\" 0))" f)
(write-line "(if (getvar \"XREFNOTIFY\") (setvar \"XREFNOTIFY\" 0))" f)
(write-line "(if (getvar \"PROXYNOTICE\") (setvar \"PROXYNOTICE\" 0))" f)
(foreach file file-list
(setq fname (vl-filename-base file))
(setq full-path (strcat temp-dir "\\" fname ".dwg"))
(setq full-path (path-slash full-path))
(write-line (strcat "_.OPEN \"" full-path "\"") f)
(write-line "_.DELAY 300" f)
(write-line (strcat "(if (findfile \"" worker-path "\") (load \"" worker-path "\"))") f)
(write-line "_.DELAY 100" f)
(write-line "_.CLOSE _N" f)
)
(write-line "(setvar \"FILEDIA\" 1)" f)
(write-line "(setvar \"CMDECHO\" 1)" f)
(write-line "(if (getvar \"SECURELOAD\") (setvar \"SECURELOAD\" 1))" f)
(write-line "(princ \"\\n==============================\")" f)
(write-line "(princ \"\\n批量打印全部完成!\")" f)
(write-line "(princ \"\\n==============================\")" f)
(write-line "(princ)" f)
(close f)
T
)
nil
)
)
nil
)
)
;; ========== DCL 中文界面 ==========
(defun write-dcl (filename / f)
(setq f (open filename "w"))
(if f
(progn
(write-line "batchplot : dialog {" f)
(write-line "label = \"批量打印 V1.1\";" f)
(write-line ": row {" f)
(write-line " : boxed_column {" f)
(write-line " label = \"待打印文件\";" f)
(write-line " : row {" f)
(write-line " : edit_box { key = \"txt_path\"; width = 30; edit_limit = 512; }" f)
(write-line " : button { label = \"...\"; key = \"btn_browse\"; width = 3; fixed_width = true; }" f)
(write-line " }" f)
(write-line " : row {" f)
(write-line " : button { label = \"加载路径\"; key = \"btn_load\"; width = 10; }" f)
(write-line " : button { label = \"添加文件\"; key = \"btn_add\"; width = 10; }" f)
(write-line " : button { label = \"清空\"; key = \"btn_clear\"; width = 6; }" f)
(write-line " }" f)
(write-line " : list_box { key = \"lst_files\"; width = 36; height = 15; multiple_select = false; }" f)
(write-line " : row {" f)
(write-line " : text { key = \"txt_count\"; label = \"共 0 个文件\"; width = 16; }" f)
(write-line " : button { label = \"删除选中\"; key = \"btn_remove\"; width = 10; }" f)
(write-line " }" f)
(write-line " }" f)
(write-line " : column {" f)
(write-line " : boxed_column {" f)
(write-line " label = \"图框设置\";" f)
(write-line " : row {" f)
(write-line " : edit_box { label = \"块名:\"; key = \"txt_block\"; width = 22; }" f)
(write-line " : button { label = \"拾取\"; key = \"btn_pick\"; width = 6; }" f)
(write-line " }" f)
(write-line " : text { label = \"多个块名用分号;分隔\"; }" f)
(write-line " }" f)
(write-line " : boxed_column {" f)
(write-line " label = \"打印机设置\";" f)
(write-line " : popup_list { label = \"打印机:\"; key = \"pop_printer\"; width = 32; }" f)
(write-line " : popup_list { label = \"样式表:\"; key = \"pop_style\"; width = 32; }" f)
(write-line " : popup_list { label = \"纸张:\"; key = \"pop_media\"; width = 32; }" f)
(write-line " }" f)
(write-line " : boxed_column {" f)
(write-line " label = \"比例设置\";" f)
(write-line " : popup_list { label = \"比例:\"; key = \"pop_scale\"; width = 18; }" f)
(write-line " : edit_box { label = \"放大系数:\"; key = \"txt_factor\"; width = 12; }" f)
(write-line " : text { label = \"(放大系数仅布满图纸时有效)\"; }" f)
(write-line " }" f)
(write-line " : boxed_column {" f)
(write-line " label = \"使用说明\";" f)
(write-line " : text { label = \"1. 路径栏可粘贴文件夹或DWG路径\"; }" f)
(write-line " : text { label = \"2. 点击[加载路径]导入文件\"; }" f)
(write-line " : text { label = \"3. 选中列表项可查看完整路径\"; }" f)
(write-line " }" f)
(write-line " }" f)
(write-line "}" f)
(write-line "spacer_1;" f)
(write-line "ok_cancel;" f)
(write-line "}" f)
(close f)
T
)
nil
)
)
;; ========== 主程序 ==========
(load-settings)
(setq plotters (get-plotters))
(setq styles (get-styles))
(setq dcl-file (vl-filename-mktemp "bp_scr" nil ".dcl"))
(write-dcl dcl-file)
(setq dcl-id (load_dialog dcl-file))
(setq loop T)
(if (valid-folder-p sel-folder)
(progn
(load-folder-files sel-folder)
(setq input-path sel-folder)
)
)
(while loop
(if (not (new_dialog "batchplot" dcl-id))
(setq loop nil)
(progn
(start_list "pop_printer") (mapcar 'add_list plotters) (end_list)
(start_list "pop_style") (mapcar 'add_list styles) (end_list)
(start_list "pop_scale")
(add_list "布满图纸")
(add_list "自动比例")
(add_list "1:1")
(end_list)
(update-file-list-display)
(if (and input-path (/= input-path ""))
(set_tile "txt_path" input-path)
(if sel-folder (set_tile "txt_path" sel-folder))
)
(cond
((= sel-scale "ScaleToFit") (set_tile "pop_scale" "0"))
((= sel-scale "Auto") (set_tile "pop_scale" "1"))
((= sel-scale "1:1") (set_tile "pop_scale" "2"))
(T (set_tile "pop_scale" "0") (setq sel-scale "ScaleToFit"))
)
(update-factor-state sel-scale)
(if sel-block (set_tile "txt_block" sel-block))
(set_tile "txt_factor" (if sel-factor sel-factor "1.0"))
(if (and sel-plotter (member sel-plotter plotters))
(set_tile "pop_printer" (itoa (vl-position sel-plotter plotters)))
)
(if (and sel-style (member sel-style styles))
(set_tile "pop_style" (itoa (vl-position sel-style styles)))
)
(defun update-media-list (idx)
(if (and plotters (< (atoi idx) (length plotters)))
(progn
(setq sel-plotter (nth (atoi idx) plotters))
(setq media-list (get-media-names sel-plotter))
(start_list "pop_media")
(if media-list
(mapcar 'add_list media-list)
(add_list "无可用纸张")
)
(end_list)
(if (and media-list sel-media (member sel-media media-list))
(set_tile "pop_media" (itoa (vl-position sel-media media-list)))
(if media-list (setq sel-media (car media-list)))
)
)
)
)
(update-media-list
(if (and sel-plotter (member sel-plotter plotters))
(itoa (vl-position sel-plotter plotters))
"0"
)
)
(action_tile "btn_pick" "(done_dialog 2)")
(action_tile "btn_browse" "(done_dialog 3)")
(action_tile "btn_load" "(done_dialog 7)")
(action_tile "btn_add" "(done_dialog 4)")
(action_tile "btn_remove" "(done_dialog 5)")
(action_tile "btn_clear" "(done_dialog 6)")
(action_tile "lst_files"
"(progn (setq selected-file-idx (atoi $value)) (update-path-display selected-file-idx))"
)
(action_tile "txt_path" "(setq input-path $value)")
(action_tile "pop_printer" "(update-media-list $value)")
(action_tile "pop_style" "(setq sel-style (nth (atoi $value) styles))")
(action_tile "pop_media" "(if media-list (setq sel-media (nth (atoi $value) media-list)))")
(action_tile "txt_block" "(setq sel-block $value)")
(action_tile "txt_factor" "(setq sel-factor $value)")
(action_tile "pop_scale"
"(progn (cond ((= $value \"0\") (setq sel-scale \"ScaleToFit\")) ((= $value \"1\") (setq sel-scale \"Auto\")) ((= $value \"2\") (setq sel-scale \"1:1\"))) (update-factor-state sel-scale))"
)
(action_tile "accept" "(setq input-path (get_tile \"txt_path\"))(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq result (start_dialog))
(cond
((= result 1)
(setq loop nil)
(if (null sel-scale) (setq sel-scale "ScaleToFit"))
(save-settings)
(if (and file-list (> (length file-list) 0) sel-block (/= sel-block "") sel-media)
(progn
(setq temp-dir "C:\\BatchPlotTemp")
(princ "\n======================================")
(princ "\n[批量打印 V1.1] 准备中...")
(princ (strcat "\n文件数: " (itoa (length file-list))))
(princ (strcat "\n图框: " sel-block))
(princ (strcat "\n比例: " sel-scale))
(princ "\n======================================")
(if (prepare-temp-env file-list temp-dir)
(progn
(setq worker-path (strcat temp-dir "\\BP_Worker.lsp"))
(setq scr-path (strcat temp-dir "\\BP_Job.scr"))
(setq factor-num (atof sel-factor))
(if (or (= factor-num 0.0) (< factor-num 0.1)) (setq factor-num 1.0))
(princ "\n生成Worker...")
(if (generate-worker-lsp worker-path sel-block sel-plotter sel-style sel-media sel-scale factor-num)
(progn
(princ " OK")
(princ "\n生成脚本...")
(if (generate-scr-file scr-path worker-path temp-dir file-list)
(progn
(princ " OK")
(unload_dialog dcl-id)
(setq dcl-id nil)
(princ "\n启动打印...")
(command "_.SCRIPT" scr-path)
)
(alert "脚本生成失败!")
)
)
(alert "Worker生成失败!")
)
)
(alert "准备临时环境失败!\n请检查磁盘空间和权限。")
)
)
(alert "请检查:\n- 文件列表不能为空\n- 必须填写图框块名\n- 必须选择纸张")
)
)
((= result 2)
(setq temp (pick-block))
(if (and temp (/= temp ""))
(if (and sel-block (/= sel-block ""))
(setq sel-block (strcat sel-block ";" temp))
(setq sel-block temp)
)
)
)
((= result 3)
(setq temp (browse-folder "选择DWG文件夹"))
(if temp (setq input-path temp))
)
((= result 4)
(setq temp (browse-single-file))
(if temp
(if (add-file-to-list temp)
(progn (setq input-path temp) (princ (strcat "\n已添加: " (vl-filename-base temp))))
(princ "\n文件已存在或无效")
)
)
)
((= result 5)
(if (and selected-file-idx (>= selected-file-idx 0) (< selected-file-idx (length file-list)))
(progn
(princ (strcat "\n已删除: " (vl-filename-base (nth selected-file-idx file-list))))
(remove-selected-file selected-file-idx)
(setq selected-file-idx nil)
)
(alert "请先选择要删除的文件")
)
)
((= result 6)
(setq file-list nil selected-file-idx nil input-path "")
(princ "\n文件列表已清空")
)
((= result 7)
(load-from-input-path input-path)
)
((= result 0) (setq loop nil))
)
)
)
)
(if dcl-id (unload_dialog dcl-id))
(if (and dcl-file (findfile dcl-file)) (vl-file-delete dcl-file))
(princ)
) 2016版本提示错误: 输入中的点位置不正确ai越来越火了 目前多文档批量打印的还真不多见，赞 厉害了兄得 厉害。兄弟厉害，AI也厉害。试试 看起来很厉害的样子 厉害了兄得
acad加载后提示命令: (LOAD "F:/资源/bplot.lsp") ; 错误: 输入中的点位置不正确。中望cad加载后提示：Error: 输入的列表有缺陷
页:
[1]
2