[求助]修改批量打印成pdf文件的源码

kongel

这是一个批量打印成pdf文件的源码，希望那位大侠能帮我加一个对图框（从左到右再从上到下）排序的功能，谢谢了。

(vl-load-com)
(setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setvar "cmdecho" 0)

(defun c:pdf( / plotdevice  minp maxp  minpoint   maxpoint tkname ourset ilast i  my  ent1  orientation)
 (setq plotdevice "pdfFactory")
 (print "select keytk" )
 (SETQ keytk (car (entsel)))
  (while (or (null keytk) (/= (cdr (assoc '0 (entget  keytk)))  "INSERT"))
  (SETQ keytk (car (entsel)))
  )  
  (setq  tkname (cdr (assoc '2 (entget  keytk)) ))
  (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))))
)  
 (setq ilast (sslength ourset))
 (setq i 0)(setq iplot 0)
  (repeat ilast
         (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->list  minpoint))
  (setq maxp (vlax-safearray->list  maxpoint))
  (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"  minp  maxp   "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)
)

edsion24

这个贴 必须顶。。。。

langjs

提供一个函数供参考：
;;; 测试
(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

回复 kongel 的帖子

1. (vl-load-com)
   
2. (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
   
3. (setvar "cmdecho" 0)
   
4. 
   
5. (defun c:pdf( / plotdevice  minp maxp  minpoint   maxpoint tkname ourset ilast i  my  ent1  orientation oursetlist)
   
6. (setq plotdevice "pdfFactory")
   
7. (print "select keytk" )
   
8. (SETQ keytk (car (entsel)))
   
9.   (while (or (null keytk) (/= (cdr (assoc '0 (entget  keytk)))  "INSERT"))
   
10.   (SETQ keytk (car (entsel)))
    
11.   )   
    
12.   (setq  tkname (cdr (assoc '2 (entget  keytk)) ))
    
13.   (alert (strcat "Do you want to print \" " tkname "\"?" ))
    
14. (setq papersize "A3")
    
15. (setq plotstyle "kongel.ctb")
    
16. (command "ucs" "w")
    
17. (print "Select what you want to print:")
    
18. (SETQ ourset (ssget (list (cons 2 tkname))))   
    
19. (while (null ourset)
    
20.   (SETQ ourset (ssget (list (cons 2 tkname))))
    
21. )   
    
22. 
    
23. 
    
24. (repeat (setq count (sslength  ourset))
    
25.   (setq oursetlist (cons (ssname ourset (setq count (1- count))) oursetlist))
    
26.   )
    
27.   ;;;排序
    
28. (setq oursetlist
    
29.        (vl-sort oursetlist
    
30.                 '(lambda (e1 e2 / p1 pP1 P2 PP2)
    
31.                    (vla-GetBoundingBox (vlax-ename->vla-object e1) 'p1 pP1)
    
32.                    (vla-GetBoundingBox (vlax-ename->vla-object e2) 'p2 pP2)
    
33.                    (SETQ P1 (vlax-safearray->list P1) P2 (vlax-safearray->list P1))
    
34.                    (cond ((< (car p1) (car p2)) T)
    
35.                          ((and (equal (car p1) (car p2) 0.00001)
    
36.                                (> (cadr p1) (cadr p2))
    
37.                           ) ;_ and
    
38.                           T
    
39.                          )
    
40.                          (T nil)
    
41.                    )
    
42.                    )
    
43.                 )
    
44.       )
    
45. (setq ilast (sslength ourset))
    
46. (setq i 0)(setq iplot 0)
    
47. 
    
48. (FOREACH my oursetlist
    
49.          (setq my (ssname ourset i))
    
50.          (setq ent1 (entget my))
    
51.   (if (= (cdr (assoc '2 ent1) ) tkname)
    
52.     (progn   
    
53.       (vla-getboundingbox (vlax-ename->vla-object my) 'minpoint 'maxpoint )
    
54.   (setq minp (vlax-safearray->list  minpoint))
    
55.   (setq maxp (vlax-safearray->list  maxpoint))
    
56.   (if ( > (- (car maxp)(car minp))(- (cadr maxp)(cadr minp)))  (setq orientation "landscape") (setq orientation "portrait"))
    
57.         (command "-plot" "y" "model" plotdevice papersize "Millimeters" orientation
    
58.    "no" "w"  minp  maxp   "fit" "c" "y" plotstyle  "y" "n" "n" "n"  "y")
    
59.    (setq iplot (1+ iplot))
    
60.        )
    
61.      )
    
62.   (setq i (1+ i))      
    
63.   )
    
64.   (princ "\nThe total is：")(princ iplot)
    
65.   (print "over!!!")
    
66.   (princ)
    
67. )
    

(vl-load-com)<br /> (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))<br /> (setvar "cmdecho" 0)<br /> <br /> (defun c:pdf( / plotdevice  minp maxp  minpoint   maxpoint tkname ourset ilast i  my  ent1  orientation oursetlist)<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 /> <br /> <br /> (repeat (setq count (sslength  ourset))<br />   (setq oursetlist (cons (ssname ourset (setq count (1- count))) oursetlist))<br />   )<br />   ;;;排序<br /> (setq oursetlist<br />        (vl-sort oursetlist<br />                 '(lambda (e1 e2 / p1 pP1 P2 PP2)<br />                    (vla-GetBoundingBox (vlax-ename->vla-object e1) 'p1 pP1)<br />                    (vla-GetBoundingBox (vlax-ename->vla-object e2) 'p2 pP2)<br />                    (SETQ P1 (vlax-safearray->list P1) P2 (vlax-safearray->list P1))<br />                    (cond ((< (car p1) (car p2)) T)<br />                          ((and (equal (car p1) (car p2) 0.00001)<br />                                (> (cadr p1) (cadr p2))<br />                           ) ;_ and<br />                           T<br />                          )<br />                          (T nil)<br />                    )<br />                    )<br />                 )<br />       )<br /> (setq ilast (sslength ourset))<br /> (setq i 0)(setq iplot 0)<br /> <br /> (FOREACH my oursetlist<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 /> )<br />

jxzhgugu

给力  好贴   

gingko_sf

这个程序对于搞设计的人太有用了，我也 一直想得到，！
在cad2010下运行了这个程序，提示："select keytk"，选择对象，实在不知道这是什么对象？请求赐教。

vlisp2012

cad2011:
选择对象:  ; 错误: 参数类型错误: safearrayp (-307564.0 458013.0 0.0)

vlisp2012

麻烦G版了！！！

oldnewlearn

输入打印样式表名称或 [?] (输入 . 表示无) <>:
是否打印线宽？[是(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"  minp  maxp   "fit" "c" "y" plotstyle  "y" "n" "n" "n"  "y")

sqqr

第33行 (SETQ P1 (vlax-safearray->list P1) P2 (vlax-safearray->list P1))
有问题是吗？？