[求助]修改批量打印成pdf文件的源码
<p>这是一个批量打印成pdf文件的源码，希望那位大侠能帮我加一个对图框（从左到右再从上到下）排序的功能，谢谢了。</p><p><br/>(vl-load-com)<br/>(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))<br/>(setvar "cmdecho" 0)</p><p>(defun c:pdf( / plotdevice minp maxp minpoint maxpoint tkname ourset ilast i my ent1 orientation)<br/> (setq plotdevice "pdfFactory")<br/> (print "select keytk" )<br/> (SETQ keytk (car (entsel)))<br/> (while (or (null keytk) (/= (cdr (assoc '0 (entget keytk))) "INSERT"))<br/> (SETQ keytk (car (entsel)))<br/> ) <br/> (setq tkname (cdr (assoc '2 (entget keytk)) ))<br/> (alert (strcat "Do you want to print \" " tkname "\"?" ))<br/>(setq papersize "A3")<br/>(setq plotstyle "kongel.ctb")<br/>(command "ucs" "w")<br/>(print "Select what you want to print:")<br/> (SETQ ourset (ssget (list (cons 2 tkname)))) <br/>(while (null ourset)<br/> (SETQ ourset (ssget (list (cons 2 tkname))))<br/>) <br/> (setq ilast (sslength ourset))<br/> (setq i 0)(setq iplot 0)<br/> (repeat ilast<br/> (setq my (ssname ourset i))<br/> (setq ent1 (entget my))<br/> (if (= (cdr (assoc '2 ent1) ) tkname) <br/> (progn <br/> (vla-getboundingbox (vlax-ename->vla-object my) 'minpoint 'maxpoint )<br/> (setq minp (vlax-safearray->list minpoint)) <br/> (setq maxp (vlax-safearray->list maxpoint))<br/> (if ( > (- (car maxp)(car minp))(- (cadr maxp)(cadr minp))) (setq orientation "landscape") (setq orientation "portrait"))<br/> (command "-plot" "y" "model" plotdevice papersize "Millimeters" orientation<br/> "no" "w" minp maxp "fit" "c" "y" plotstyle "y" "n" "n" "n" "y")<br/> (setq iplot (1+ iplot)) <br/> )<br/> ) <br/> (setq i (1+ i)) <br/> )<br/> (princ "\nThe total is：")(princ iplot)<br/> (print "over!!!")<br/> (princ)<br/>)</p> 这个贴 必须顶。。。。 提供一个函数供参考：;;; 测试
(defun C:TT ()
(setq b '(((20.0 10.0 0.0) (30.0 20.0 0.0)) ((40.0 30.0 0.0) (50.0 40.0 0.0))
((60.0 30.0 0.0) (70.0 40.0 0.0))
((20.0 50.0 0.0) (30.0 60.0 0.0))
((20.0 30.0 0.0) (30.0 40.0 0.0))
)
)
(setq b (MBPX b)) ; 返回b=(((20.0 50.0 0.0) (30.0 60.0 0.0)) ((20.0 30.0 0.0) (30.0 40.0 0.0)) ((40.0 30.0 0.0)
; (50.0 40.0 0.0)) ((60.0 30.0 0.0) (70.0 40.0 0.0)) ((20.0 10.0 0.0) (30.0 20.0 0.0)))(((20.0
; 50.0 0.0) (30.0 60.0 0.0)) ((20.0 30.0 0.0) (30.0 40.0 0.0)) ((40.0 30.0 0.0) (50.0 40.0
; 0.0)) ((60.0 30.0 0.0) (70.0 40.0 0.0)) ((20.0 10.0 0.0) (30.0 20.0 0.0)))
(princ "\nb====")
(princ b)
)
;;; 子函数，最小坐标点和最大坐标点组合的列表，按最小点坐标由左到右由上到下的顺序排序。
(defun MBPX (b / a e1 e2 q)
(setq a (vl-sort b (function (lambda (e1 e2)
(< (car (car e1)) (car (car e2)))
)
)
)
)
(setq Q (vl-sort a (function (lambda (e1 e2)
(> (cadr (car e1)) (cadr (car e2)))
)
)
)
)
q
)
本帖最后由 Gu_xl 于 2011-3-14 22:57 编辑
回复 kongel 的帖子
(vl-load-com)
(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setvar "cmdecho" 0)
(defun c:pdf( / plotdeviceminp maxpminpoint maxpoint tkname ourset ilast imyent1orientation oursetlist)
(setq plotdevice "pdfFactory")
(print "select keytk" )
(SETQ keytk (car (entsel)))
(while (or (null keytk) (/= (cdr (assoc '0 (entgetkeytk)))"INSERT"))
(SETQ keytk (car (entsel)))
)
(setqtkname (cdr (assoc '2 (entgetkeytk)) ))
(alert (strcat "Do you want to print \" " tkname "\"?" ))
(setq papersize "A3")
(setq plotstyle "kongel.ctb")
(command "ucs" "w")
(print "Select what you want to print:")
(SETQ ourset (ssget (list (cons 2 tkname))))
(while (null ourset)
(SETQ ourset (ssget (list (cons 2 tkname))))
)
(repeat (setq count (sslengthourset))
(setq oursetlist (cons (ssname ourset (setq count (1- count))) oursetlist))
)
;;;排序
(setq oursetlist
(vl-sort oursetlist
'(lambda (e1 e2 / p1 pP1 P2 PP2)
(vla-GetBoundingBox (vlax-ename->vla-object e1) 'p1 pP1)
(vla-GetBoundingBox (vlax-ename->vla-object e2) 'p2 pP2)
(SETQ P1 (vlax-safearray->list P1) P2 (vlax-safearray->list P1))
(cond ((< (car p1) (car p2)) T)
((and (equal (car p1) (car p2) 0.00001)
(> (cadr p1) (cadr p2))
) ;_ and
T
)
(T nil)
)
)
)
)
(setq ilast (sslength ourset))
(setq i 0)(setq iplot 0)
(FOREACH my oursetlist
(setq my (ssname ourset i))
(setq ent1 (entget my))
(if (= (cdr (assoc '2 ent1) ) tkname)
(progn
(vla-getboundingbox (vlax-ename->vla-object my) 'minpoint 'maxpoint )
(setq minp (vlax-safearray->listminpoint))
(setq maxp (vlax-safearray->listmaxpoint))
(if ( > (- (car maxp)(car minp))(- (cadr maxp)(cadr minp)))(setq orientation "landscape") (setq orientation "portrait"))
(command "-plot" "y" "model" plotdevice papersize "Millimeters" orientation
"no" "w"minpmaxp "fit" "c" "y" plotstyle"y" "n" "n" "n""y")
(setq iplot (1+ iplot))
)
)
(setq i (1+ i))
)
(princ "\nThe total is：")(princ iplot)
(print "over!!!")
(princ)
)
给力好贴
这个程序对于搞设计的人太有用了，我也 一直想得到，！
在cad2010下运行了这个程序，提示："select keytk"，选择对象，实在不知道这是什么对象？请求赐教。 cad2011:
选择对象:; 错误: 参数类型错误: safearrayp (-307564.0 458013.0 0.0) 麻烦G版了！！！ 本帖最后由 oldnewlearn 于 2012-3-3 21:55 编辑
输入打印样式表名称或 [?] (输入 . 表示无) <>:
是否打印线宽？[是(Y)/否(N)] <是>:
输入着色打印设置 [按显示(A)/线框(W)/隐藏(H)/视觉样式(V)/渲染(R)] <按显示>:
是否保存对页面设置的修改 [是(Y)/否(N)]? <N> n
是否继续打印？[是(Y)/否(N)] <Y>: y
看倒数第3个参数，好像不对。“输入着色打印设置 [按显示(A)/线框(W)/隐藏(H)/视觉样式(V)/渲染(R)] <按显示>:”
(command "-plot" "y" "model" plotdevice papersize "Millimeters" orientation"no" "w"minpmaxp "fit" "c" "y" plotstyle"y" "n" "n" "n""y")
第33行 (SETQ P1 (vlax-safearray->list P1) P2 (vlax-safearray->list P1))
有问题是吗？？
页:
[1]
2