AutoCAD 批量导入 PDF 插件(一)

;;; ============================================================;;; PDFBATCH - 批量导入 PDF 页面到 AutoCAD;;; 命令: INPDF;;; 说明: 逐页调用 -PDFIMPORT，按网格自动排布，互不重叠;;;       点击「预览」按钮可用系统默认 PDF 阅读器打开文件;;;       页码支持范围与指定页混合, 如 1-10 / 1,2,10,20 / 1-5,8,10-12;;;       导入完成后自动最大化显示所有导入对象;;; 适用: AutoCAD 2017 及以上（需 -PDFIMPORT 命令）;;; BY：麻瓜工坊  作者：MAGUA;;; ============================================================(vl-load-com);; ------------------ 工具函数 ------------------(defun pdfb:zero-list (n / lst)  (setq lst nil)  (repeat n (setq lst (cons 0.0 lst)))  lst)(defun pdfb:replace-nth (n val lst / i out)  (setq i 0 out nil)  (foreach x lst    (setq out (cons (if (= i n) val x) out))    (setq i (1+ i))  )  (reverse out))(defun pdfb:update-row-height (hs r h)  (if (>= r (length hs))    (append hs (list h))    (pdfb:replace-nth r (max h (nth r hs)) hs)  ))(defun pdfb:new-entities (lastEnt / ss e)  (setq ss (ssadd))  (setq e (if lastEnt (entnext lastEnt) (entnext)))  (while e    (ssadd e ss)    (setq e (entnext e))  )  ss)(defun pdfb:ss-bbox (ss / i e obj mn mx p1 p2 res minPt maxPt)  (setq i 0 mn nil mx nil)  (while (< i (sslength ss))    (setq e (ssname ss i))    (setq obj (vlax-ename->vla-object e))    (setq res (vl-catch-all-apply                '(lambda ()                   (vla-getboundingbox obj 'minPt 'maxPt)                 )              )    )    (if (not (vl-catch-all-error-p res))      (progn        (setq p1 (vlax-safearray->list minPt)              p2 (vlax-safearray->list maxPt))        (if mn          (setq mn (mapcar 'min mn p1)                mx (mapcar 'max mx p2))          (setq mn p1 mx p2)        )      )    )    (setq i (1+ i))  )  (if mn (list mn mx)))(defun pdfb:move-ss (ss from to)  (vl-cmdf "_.MOVE" ss "" from to));; 解析页码表达式, 支持范围和指定页混合:;;   "1-10"          -> (1 2 3 ... 10);;   "1,2,10,20"     -> (1 2 10 20);;   "1-5,8,10-12"   -> (1 2 3 4 5 8 10 11 12);; 只识别数字和 '-', 其余字符(逗号/中文逗号/顿号/分号/空格)均作分隔符;; token 内 a-b 且 b<a 时自动交换(defun pdfb:parse-pages (s / result i len ch cur tokens tk pos a b tmp)  (setq result nil tokens nil cur "" i 1 len (strlen s))  (while (<= i len)    (setq ch (substr s i 1))    (if (or (and (>= (ascii ch) 48) (<= (ascii ch) 57)) (= ch "-"))      (setq cur (strcat cur ch))      (if (/= cur "")        (progn (setq tokens (append tokens (list cur)) cur ""))      )    )    (setq i (1+ i))  )  (if (/= cur "") (setq tokens (append tokens (list cur))))  (foreach tk tokens    (setq pos (vl-string-search "-" tk))    (if pos      (progn        (setq a (atoi (substr tk 1 pos)))        (setq b (atoi (substr tk (+ pos 2))))        (if (and (> a 0) (> b 0))          (progn            (if (> a b) (setq tmp a a b b tmp))            (setq i a)            (while (<= i b)              (setq result (append result (list i)))              (setq i (1+ i))            )          )        )      )      (progn        (setq a (atoi tk))        (if (> a 0) (setq result (append result (list a))))      )    )  )  result);; ------------------ 打开文件（外部预览） ------------------(defun pdfb:open-file (path / ok)  (cond    ((or (null path) (= path ""))      (alert "请先选择 PDF 文件。"))    ((not (findfile path))      (alert (strcat "文件不存在:\n" path)))    (t      (setq ok (vl-catch-all-apply 'startapp (list path)))      (if (or (vl-catch-all-error-p ok) (null ok))        (vl-catch-all-apply          'startapp          (list "explorer.exe" path))      )    )  )  (princ));; ------------------ 内嵌 DCL ------------------(defun pdfb:write-dcl ( / fn f)  (setq fn (vl-filename-mktemp "pdfbatch" "" ".dcl"))  (setq f (open fn "w"))  (foreach ln    (list      "pdfbatch : dialog {"      "  label = \"MAGUA-批量导入 PDF \";"      "  : boxed_column {"      "    label = \"PDF 文件\";"      "    : row {"      "      alignment = left;"      "      : concatenation {"      "        : edit_box { key = \"eb_file\"; edit_width = 40; }"      "      }"      "    }"      "    : row {"      "      alignment = right;"      "      : button { key = \"btn_browse\";  label = \"浏览...\"; fixed_width = true; width = 8; }"      "      : button { key = \"btn_preview\"; label = \"预览\";     fixed_width = true; width = 8; }"      "    }"      "    : text { label = \"提示: 可通过「预览」浏览 PDF 文件\"; }"      "  }"      "  : boxed_column {"      "    label = \"页码\";"      "    : row {"      "      alignment = left;"      "      : concatenation {"      "        : edit_box { key = \"eb_pages\"; edit_width = 40; value = \"1\"; }"      "      }"      "    }"      "    : text { label = \"示例: 1-10 或 1,2,10,20 或 1-5,8,10-12\"; }"      "  }"      "  : boxed_column {"      "    label = \"布局设置\";"      "    : row {"      "      alignment = left;"      "      : concatenation {"      "        : text { label = \"每行列数\"; alignment = right; fixed_width = true; width = 8; }"      "        : edit_box { key = \"eb_cols\";  edit_width = 6; value = \"3\"; }"      "      }"      "      : concatenation {"      "        : text { label = \"导入比例\"; alignment = right; fixed_width = true; width = 8; }"      "        : edit_box { key = \"eb_scale\"; edit_width = 6; value = \"1.0\"; }"      "      }"      "    }"      "    : row {"      "      alignment = left;"      "      : concatenation {"      "        : text { label = \"水平间距\"; alignment = right; fixed_width = true; width = 8; }"      "        : edit_box { key = \"eb_gapx\"; edit_width = 6; value = \"50\"; }"      "      }"      "      : concatenation {"      "        : text { label = \"垂直间距\"; alignment = right; fixed_width = true; width = 8; }"      "        : edit_box { key = \"eb_gapy\"; edit_width = 6; value = \"50\"; }"      "      }"      "    }"      "  }"      "  : row {"      "    alignment = right;"      "    : button { key = \"btn_ok\";     label = \"开始导入\"; is_default = true; fixed_width = true; width = 8; }"      "    : button { key = \"btn_cancel\"; label = \"取消\";     is_cancel = true; fixed_width = true; width = 8; }"      "  }"      "}"    )    (write-line ln f)  )  (close f)  fn);; ------------------ 对话框回调 ------------------(defun pdfb:browse ( / f)  (setq f (getfiled "选择 PDF 文件" "" "pdf" 0))  (if f (set_tile "eb_file" f))  (princ))(defun pdfb:preview ( / f)  (setq f (get_tile "eb_file"))  (pdfb:open-file f))(defun pdfb:collect ( / f c gx gy sc ps pages)  (setq f (get_tile "eb_file"))  (cond    ((or (null f) (= f ""))      (alert "请先选择 PDF 文件。") nil)    ((not (findfile f))      (alert (strcat "文件不存在:\n" f)) nil)    (t      (setq c  (atoi (get_tile "eb_cols"))            gx (atof (get_tile "eb_gapx"))            gy (atof (get_tile "eb_gapy"))            sc (atof (get_tile "eb_scale"))            ps (get_tile "eb_pages")            pages (pdfb:parse-pages (if ps ps "")))      (cond        ((null pages)          (alert "请填写有效页码，例如:\n1-10\n1,2,10,20\n1-5,8,10-12") nil)        ((< c 1)   (alert "每行列数必须 >= 1") nil)        ((<= sc 0) (alert "比例必须 > 0") nil)        (t (list f pages c gx gy sc))      )    )  ));; ------------------ 核心导入 ------------------(defun pdfb:do-import (pdfFile pageList cols gapX gapY scaleVal /                       basePt pagesData pg before res newSS bb w h tempX                       n idx r c item ss                       rowHeights colWidths colOffsets rowOffsets                       j targetX targetY zoomSS k)  (setq basePt (getpoint "\n指定第一页插入点: "))  (if (null basePt)    (princ "\n已取消。")    (progn      (princ (strcat "\n开始导入 " (itoa (length pageList)) " 页..."))      (setq pagesData nil tempX 0.0)      (foreach pg pageList        (princ (strcat "\n  导入第 " (itoa pg) " 页..."))        (setq before (entlast))        (setq res (vl-catch-all-apply                    'vl-cmdf                    (list "_.-PDFIMPORT" "_F" pdfFile (itoa pg)                          (list tempX 0.0 0.0) scaleVal 0.0)))        (setq newSS (if (vl-catch-all-error-p res)                      nil                      (pdfb:new-entities before)))        (if (or (null newSS) (= (sslength newSS) 0))          (princ " 失败或空页。")          (progn            (setq bb (pdfb:ss-bbox newSS))            (if bb              (progn                (setq w (- (caadr bb)  (caar bb))                      h (- (cadadr bb) (cadar bb)))                (setq pagesData (append pagesData (list (list newSS bb w h))))                (setq tempX (+ tempX w 100.0))                (princ " 完成。")              )              (princ " 无法计算尺寸。")            )          )        )      )      (if (null pagesData)        (princ "\n没有成功导入任何页面。")        (progn          (setq n (length pagesData))          (setq colWidths (pdfb:zero-list cols))          (setq rowHeights nil)          (setq idx 0)          (foreach item pagesData            (setq w (nth 2 item) h (nth 3 item)                  r (/ idx cols) c (rem idx cols))            (if (> w (nth c colWidths))              (setq colWidths (pdfb:replace-nth c w colWidths)))            (setq rowHeights (pdfb:update-row-height rowHeights r h))            (setq idx (1+ idx))          )          (setq colOffsets (pdfb:zero-list cols))          (setq j 1)          (while (< j cols)            (setq colOffsets              (pdfb:replace-nth j                (+ (nth (1- j) colOffsets)                   (nth (1- j) colWidths)                   gapX)                colOffsets))            (setq j (1+ j))          )          (setq rowOffsets (pdfb:zero-list (length rowHeights)))          (setq j 1)          (while (< j (length rowHeights))            (setq rowOffsets              (pdfb:replace-nth j                (+ (nth (1- j) rowOffsets)                   (nth (1- j) rowHeights)                   gapY)                rowOffsets))            (setq j (1+ j))          )          (setq idx 0 zoomSS (ssadd))          (foreach item pagesData            (setq ss (nth 0 item) bb (nth 1 item) h (nth 3 item)                  r (/ idx cols) c (rem idx cols))            (setq targetX (+ (car basePt) (nth c colOffsets)))            (setq targetY (- (cadr basePt) (nth r rowOffsets) h))            (pdfb:move-ss ss (car bb) (list targetX targetY 0.0))            (setq k 0)            (while (< k (sslength ss))              (ssadd (ssname ss k) zoomSS)              (setq k (1+ k))            )            (setq idx (1+ idx))          )          (princ (strcat "\n完成: 共导入 " (itoa n) " 页。"))          (if (> (sslength zoomSS) 0)            (progn              (vl-cmdf "_.ZOOM" "_O" zoomSS "")              (princ "\n已最大化显示导入对象。")            )          )        )      )    )  )  (princ));; ------------------ 主命令 ------------------(defun c:INPDF ( / dclFile dclId oldFiledia result)  (setq dclFile (pdfb:write-dcl))  (setq dclId (load_dialog dclFile))  (if (< dclId 0)    (princ "\n无法加载 DCL 对话框。")    (progn      (setq *pdfb-result* nil *pdfb-cancel* nil)      (while (and (not *pdfb-cancel*) (not *pdfb-result*))        (if (new_dialog "pdfbatch" dclId)          (progn            (action_tile "btn_browse"  "(pdfb:browse)")            (action_tile "btn_preview" "(pdfb:preview)")            (action_tile "btn_cancel"  "(setq *pdfb-cancel* T)(done_dialog 0)")            (action_tile "btn_ok"              "(if (setq *pdfb-result* (pdfb:collect)) (done_dialog 1))")            (start_dialog)          )          (setq *pdfb-cancel* T)        )      )      (unload_dialog dclId)      (vl-catch-all-apply 'vl-file-delete (list dclFile))      (if *pdfb-result*        (progn          (setq oldFiledia (getvar "FILEDIA"))          (setvar "FILEDIA" 0)          (setq result (vl-catch-all-apply 'pdfb:do-import *pdfb-result*))          (setvar "FILEDIA" oldFiledia)          (if (vl-catch-all-error-p result)            (princ (strcat "\n导入过程中出错: "                           (vl-catch-all-error-message result)))          )        )      )    )  )  (princ))(princ)