明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 4366|回复: 16

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

  [复制链接]
发表于 2009-2-9 12:29:00 | 显示全部楼层 |阅读模式

这是一个批量打印成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)
)

发表于 2011-3-14 21:40:28 | 显示全部楼层
这个贴 必须顶。。。。
发表于 2011-3-14 22:44:46 | 显示全部楼层
提供一个函数供参考:
;;; 测试
(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
)
发表于 2011-3-14 22:56:13 | 显示全部楼层
本帖最后由 Gu_xl 于 2011-3-14 22:57 编辑

回复 kongel 的帖子

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

  4. (defun c:pdf( / plotdevice  minp maxp  minpoint   maxpoint tkname ourset ilast i  my  ent1  orientation oursetlist)
  5. (setq plotdevice "pdfFactory")
  6. (print "select keytk" )
  7. (SETQ keytk (car (entsel)))
  8.   (while (or (null keytk) (/= (cdr (assoc '0 (entget  keytk)))  "INSERT"))
  9.   (SETQ keytk (car (entsel)))
  10.   )   
  11.   (setq  tkname (cdr (assoc '2 (entget  keytk)) ))
  12.   (alert (strcat "Do you want to print \" " tkname "\"?" ))
  13. (setq papersize "A3")
  14. (setq plotstyle "kongel.ctb")
  15. (command "ucs" "w")
  16. (print "Select what you want to print:")
  17. (SETQ ourset (ssget (list (cons 2 tkname))))   
  18. (while (null ourset)
  19.   (SETQ ourset (ssget (list (cons 2 tkname))))
  20. )   


  21. (repeat (setq count (sslength  ourset))
  22.   (setq oursetlist (cons (ssname ourset (setq count (1- count))) oursetlist))
  23.   )
  24.   ;;;排序
  25. (setq oursetlist
  26.        (vl-sort oursetlist
  27.                 '(lambda (e1 e2 / p1 pP1 P2 PP2)
  28.                    (vla-GetBoundingBox (vlax-ename->vla-object e1) 'p1 pP1)
  29.                    (vla-GetBoundingBox (vlax-ename->vla-object e2) 'p2 pP2)
  30.                    (SETQ P1 (vlax-safearray->list P1) P2 (vlax-safearray->list P1))
  31.                    (cond ((< (car p1) (car p2)) T)
  32.                          ((and (equal (car p1) (car p2) 0.00001)
  33.                                (> (cadr p1) (cadr p2))
  34.                           ) ;_ and
  35.                           T
  36.                          )
  37.                          (T nil)
  38.                    )
  39.                    )
  40.                 )
  41.       )
  42. (setq ilast (sslength ourset))
  43. (setq i 0)(setq iplot 0)

  44. (FOREACH my oursetlist
  45.          (setq my (ssname ourset i))
  46.          (setq ent1 (entget my))
  47.   (if (= (cdr (assoc '2 ent1) ) tkname)
  48.     (progn   
  49.       (vla-getboundingbox (vlax-ename->vla-object my) 'minpoint 'maxpoint )
  50.   (setq minp (vlax-safearray->list  minpoint))
  51.   (setq maxp (vlax-safearray->list  maxpoint))
  52.   (if ( > (- (car maxp)(car minp))(- (cadr maxp)(cadr minp)))  (setq orientation "landscape") (setq orientation "portrait"))
  53.         (command "-plot" "y" "model" plotdevice papersize "Millimeters" orientation
  54.    "no" "w"  minp  maxp   "fit" "c" "y" plotstyle  "y" "n" "n" "n"  "y")
  55.    (setq iplot (1+ iplot))
  56.        )
  57.      )
  58.   (setq i (1+ i))      
  59.   )
  60.   (princ "\nThe total is:")(princ iplot)
  61.   (print "over!!!")
  62.   (princ)
  63. )

点评

G版很给力!  发表于 2012-3-5 11:06

评分

参与人数 1明经币 +1 收起 理由
vlisp2012 + 1 很给力!

查看全部评分

发表于 2011-3-15 21:43:14 | 显示全部楼层
给力  好贴   
发表于 2012-3-3 10:24:26 | 显示全部楼层
这个程序对于搞设计的人太有用了,我也 一直想得到,
在cad2010下运行了这个程序,提示:"select keytk",选择对象,实在不知道这是什么对象?请求赐教。
发表于 2012-3-3 20:43:59 | 显示全部楼层
cad2011:
选择对象:  ; 错误: 参数类型错误: safearrayp (-307564.0 458013.0 0.0)
发表于 2012-3-3 20:45:38 | 显示全部楼层
麻烦G版了!!!
发表于 2012-3-3 21:49:16 | 显示全部楼层
本帖最后由 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"  minp  maxp   "fit" "c" "y" plotstyle  "y" "n" "n" "n"  "y")
发表于 2012-3-4 17:34:49 | 显示全部楼层

第33行 (SETQ P1 (vlax-safearray->list P1) P2 (vlax-safearray->list P1))
有问题是吗??
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-5-26 13:14 , Processed in 0.191926 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表