简易cad导出pdf程序源码

由于工作关系时常用到cad转pdf
(defun c:pdf (/ all-boxlst boxlst i maxpt minpt n out-id print-device print-front print-paper print-space print-style print-unit)
(princ “/n此程序只能应用于简易的pdf打印，需要安装pdffactory虚拟打印机，默认图纸尺寸为A3，打印样式为全黑，打比例为布满图纸”)
(vl-load-com)
(setq print-space “Model”)
(setq print-device “pdfFactory Pro”)
(setq print-style “monochrome.ctb”)
(setq print-paper “A3”)
(setq print-unit “Millimeters”)
(setq all-boxlst (all-boxlst-get))
(setq i 0)
(setq n (length all-boxlst))
(while (< i n)
(setq boxlst (nth i all-boxlst))
(setq minpt (car boxlst))
(setq maxpt (cadr boxlst))
(setq print-front (judge-print-front boxlst))
(setq out-id (file-path/name-get))
(command “Plot” “Y” print-space print-device print-paper print-unit print-front “N” “W” minpt maxpt “F” “C” “Y” print-style “Y” “W” “Y” out-id “N” “Y”)
(setq i (1+ i))
)
)
;;取得文件路径文件名
(defun file-path/name-get (/ file-name file-path mycad mydoc myms)
(setq mycad (vlax-get-acad-object))
(setq mydoc (vla-get-ActiveDocument mycad))
(setq myms (vla-get-ModelSpace mydoc))
(setq file-path (vlax-get-property mydoc 'path))
(setq file-name (vlax-get-property mydoc 'name))
(setq file-name (substr file-name 1 (- (strlen file-name) 4)))
(strcat file-path file-name)
)
;;取得图框最大最小点
(defun all-boxlst-get (/ all-boxlst box-name i n ss-box)
(setq all-boxlst nil)
(princ “\n请选择矩形框或图块框”)
(setq ss-box (ssget))
(setq n (sslength ss-box))
(setq i 0)
(while (< i n)
(setq box-name (ssname ss-box i))
(setq all-boxlst (cons (minpt/maxpt-get box-name) all-boxlst))
(setq i (1+ i))
)
(setq all-boxlst (mapcar '(lambda (x) (list (3vp->2vp (car x)) (3vp->2vp (cadr x)))) all-boxlst))
(vl-sort all-boxlst '(lambda (e1 e2) (< (car (car e1)) (car (car e2)))))
)
;;从图元对象取得最大最小点
(defun minpt/maxpt-get (obj / maxpt minpt)
(setq obj (vlax-ename->vla-object obj))
(vla-GetBoundingBox obj 'minp 'maxp)
(setq minpt (vlax-safearray->list minp))
(setq maxpt (vlax-safearray->list maxp))
(vlax-release-object obj)
(list minpt maxpt)
)
;;判断打印方向
(defun judge-print-front (boxlst / maxpt minpt print-front)
(setq minpt (car boxlst))
(setq maxpt (cadr boxlst))
(if (>= (- (car maxpt) (car minpt)) (- (cadr maxpt) (cadr minpt)))
(setq print-front “L”)
(setq print-front “P”)
)
)
;;三维点转二维点
(defun 3vp->2vp (pt) (list (car pt) (cadr pt)))