设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 自动判断图幅打印pdf
12345下一页
返回列表 发新帖
查看: 6263|回复: 40

[源码] 自动判断图幅打印pdf

  [复制链接]
war32
发表于 2015-11-6 15:59 | 显示全部楼层 |阅读模式
本帖最后由 war32 于 2015-11-6 16:09 编辑

潜伏很久了，终于有了个能用的东西，抄了论坛里的很多代码，感谢各位帮助过我的朋友们，感谢明经QQ群里各位的帮助。
好了，程序仅支持图框为块，可多选，不可框选，图框块的名称里必须有A1，A2，A3，A4的字符串，因为我是靠拾取图框中图号好图纸名称用来命名，请各位自行更改程序中定义图号和名称位置的数据。

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x

评分

参与人数 2明经币 +2 收起 理由
w245272914 + 1 很给力! 热心助人
USER2128 + 1 值得表扬！

查看全部评分

本帖被以下淘专辑推荐:

  • · 工具|主题: 71, 订阅: 4
回复

使用道具 举报

dd131028
发表于 2020-6-18 09:43 | 显示全部楼层
本帖最后由 dd131028 于 2020-6-18 09:44 编辑
war32 发表于 2020-6-15 20:33
代码发上来看看？
在你的基础上加的A0，打印时就是打印不出来，别的A1~A4都可以打印，能帮我看看那边错了吗？谢谢。。。
  1. (defun c:zx(/ en end end_data ff ffn h lujing maxp maxx maxy minp minx miny name newdname1 newdname2 p1 p2 st tufu w x x1 x2 y y1 y2 i)
  2.         (setvar "cmdecho" 0)
  3.         (setq en (ssget))
  4.         (setq i 0)
  5.         (repeat (sslength en)
  6.                 (setq end (ssname en i))
  7.                 (setq end_data (entget end))
  8.                 (vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)
  9.                 (setq minp (vlax-safearray->list minp)
  10.                         maxp (vlax-safearray->list maxp))
  11.                 (setq minx (car minp)
  12.                         maxx (car maxp)
  13.                         miny (cadr minp)
  14.                         maxy (cadr maxp))
  15.                 (setq w (- maxx minx)
  16.                         h (- maxy miny))
  17.                 (setq p1 minp)
  18.                 (setq p2 maxp)
  19.                 ;判断横向还是纵向,p纵向，l横向
  20.                 (setq x1 (car p1) y1 (cadr p1) x2 (car p2) y2 (cadr p2))
  21.                 (setq x (abs (- x1 x2)) y (abs (- y1 y2)) )
  22.                 (if (> y x) (setq st "p") (setq st "l"))
  23.                 ;依次拾取图号和图纸名称
  24.                 (setq name (fanhuituhao  end st))
  25.                 ;;;将选取的的图号和名称存到文件中
  26.                 (setq NewDName1 (zifutihuan (car name)))
  27.                 (setq NewDName2 (zifutihuan (cadr name)))
  28.                 (setq ffn "D:\\drawing1.xls")
  29.                 (setq ff (open ffn "a"))
  30.                 (princ "\n" ff)
  31.                 (princ newdname1 ff)
  32.                 (princ "\t" ff)
  33.                 (princ newdname2 ff)
  34.                 (princ "\t" ff)
  35.                 (close ff)
  36.                 (setq lujing (strcat "d:\\" NewDName1 "-" NewDName2))
  37.                                 (cond
  38.                                         ((vl-string-search "A0" (vlax-get-property (vlax-ename->vla-object end) "Name") ) (setq tufu "ISO expand A0 (1189.00 x 841.00 毫米)"))               
  39.                                                 ((vl-string-search "A1" (vlax-get-property (vlax-ename->vla-object end) "Name") ) (setq tufu "ISO expand A1 (841.00 x 594.00 毫米)"))
  40.                         ((vl-string-search "A2" (vlax-get-property (vlax-ename->vla-object end) "Name") ) (setq tufu "ISO expand A2 (594.00 x 420.00 毫米)"))
  41.                         ((vl-string-search "A3" (vlax-get-property (vlax-ename->vla-object end) "Name") ) (setq tufu "ISO expand A3 (420.00 x 297.00 毫米)"))
  42.                         ((vl-string-search "A4" (vlax-get-property (vlax-ename->vla-object end) "Name") ) (setq tufu "ISO expand A4 (297.00 x 210.00 毫米)"))
  43.                         (T nil)
  44.                 )
  45.                
  46.                
  47.                 (pdfplot st p1 p2 tufu lujing)
  48.           (setq i (1+ i))
  49.         )
  50.         
  51. )


  54. (defun fanhuituhao (objname fangxiang / name obj tuhao)
  55.         (setq obj (vlax-ename->vla-object objname))
  56.         
  57.         (setq name (vlax-get-property obj "Name"))
  58.         (cond ((/= (vl-string-search "A0" name ) nil) (setq tuhao (a0name obj fangxiang)))
  59.                                  ((/= (vl-string-search "A1" name ) nil) (setq tuhao (a1name obj fangxiang)))
  60.                 ((/= (vl-string-search "A2" name ) nil) (setq tuhao (a2name obj fangxiang)))
  61.                 ((/= (vl-string-search "A3" name ) nil) (setq tuhao (a3name obj fangxiang)))
  62.                 ((/= (vl-string-search "A4" name ) nil) (setq tuhao (a4name obj fangxiang)))
  63.                 ( T nil)
  64.         )
  65.         
  66. )
  67. (defun a0name (obj fangxiang / h maxp maxx maxx0 maxy maxy0 minp minx miny miny0 scl w)
  68.         (setq minx 1e6 miny0 1e6 maxx0 -1e6 maxy0 -1e6)
  69.         (vla-getboundingbox obj 'Minp 'Maxp)
  70.         (setq minp (vlax-safearray->list minp)
  71.                 maxp (vlax-safearray->list maxp)
  72.         )
  73.         (setq minx (car minp)
  74.                 maxx (car maxp)
  75.                 miny (cadr minp)
  76.                 maxy (cadr maxp))
  77.         (setq w (- maxx minx)
  78.                 h (- maxy miny))
  79.         (if (= fangxiang "l") (setq scl (/ h 841)) (setq scl (/ h 1189)) )
  80.         
  81.         (a1a2name maxx miny)
  82. )


  85. (defun a1name (obj fangxiang / h maxp maxx maxx0 maxy maxy0 minp minx miny miny0 scl w)
  86.         (setq minx 1e6 miny0 1e6 maxx0 -1e6 maxy0 -1e6)
  87.         (vla-getboundingbox obj 'Minp 'Maxp)
  88.         (setq minp (vlax-safearray->list minp)
  89.                 maxp (vlax-safearray->list maxp)
  90.         )
  91.         (setq minx (car minp)
  92.                 maxx (car maxp)
  93.                 miny (cadr minp)
  94.                 maxy (cadr maxp))
  95.         (setq w (- maxx minx)
  96.                 h (- maxy miny))
  97.         (if (= fangxiang "l") (setq scl (/ h 594)) (setq scl (/ h 841)) )
  98.         
  99.         (a1a2name maxx miny)
  100. )

  102. (defun a2name (obj fangxiang / h maxp maxx maxx0 maxy maxy0 minp minx miny miny0 scl w)
  103.         (setq minx 1e6 miny0 1e6 maxx0 -1e6 maxy0 -1e6)
  104.         (vla-getboundingbox obj 'Minp 'Maxp)
  105.         (setq minp (vlax-safearray->list minp)
  106.                 maxp (vlax-safearray->list maxp)
  107.         )
  108.         (setq minx (car minp)
  109.                 maxx (car maxp)
  110.                 miny (cadr minp)
  111.                 maxy (cadr maxp))
  112.         (setq w (- maxx minx)
  113.                 h (- maxy miny))
  114.         (if (= fangxiang "l") (setq scl (/ h 420)) (setq scl (/ h 594)) )
  115.         (a1a2name maxx miny)
  116. )
  117. (defun a3name (obj fangxiang / h maxp maxx maxx0 maxy maxy0 minp minx miny miny0 scl w)
  118.         (setq minx 1e6 miny0 1e6 maxx0 -1e6 maxy0 -1e6)
  119.         (vla-getboundingbox obj 'Minp 'Maxp)
  120.         (setq minp (vlax-safearray->list minp)
  121.                 maxp (vlax-safearray->list maxp)
  122.         )
  123.         (setq minx (car minp)
  124.                 maxx (car maxp)
  125.                 miny (cadr minp)
  126.                 maxy (cadr maxp))
  127.         (setq w (- maxx minx)
  128.                 h (- maxy miny))
  129.         (if (= fangxiang "l") (setq scl (/ h 297)) (setq scl (/ h 420)) )
  130.         (a3a4name maxx miny)
  131. )

  133. (defun a4name (obj fangxiang / h maxp maxx maxx0 maxy maxy0 minp minx miny miny0 scl w)
  134.         (setq minx 1e6 miny0 1e6 maxx0 -1e6 maxy0 -1e6)
  135.         (vla-getboundingbox obj 'Minp 'Maxp)
  136.         (setq minp (vlax-safearray->list minp)
  137.                 maxp (vlax-safearray->list maxp)
  138.         )
  139.         (setq minx (car minp)
  140.                 maxx (car maxp)
  141.                 miny (cadr minp)
  142.                 maxy (cadr maxp))
  143.         (setq w (- maxx minx)
  144.                 h (- maxy miny))
  145.         (if (= fangxiang "l") (setq scl (/ h 210)) (setq scl (/ h 297)) )
  146.         (a3a4name maxx miny)
  147. )


  150. (defun a1a2name (maxx miny / mingcheng mingcheng_data mingcheng_name mingcheng_name1 mx1 mx2 my1 my2 pt_list pt_list1 px1 px2 px3 px4 px5 px6 px7 px8 tuhao tuhao_data tuhao_name tuhao_name1 tx1 tx2 ty1 ty2)
  151.         (setq tx1 (- maxx (* scl 54)))
  152.         (setq ty1 (+ miny (* scl 10)))
  153.         (setq tx2 (- maxx (* scl 10)))
  154.         (setq ty2 (+ miny (* scl 20)))
  155.         (setq px1 (list tx1 ty1))
  156.         (setq px2 (list tx2 ty1))
  157.         (setq px3 (list tx2 ty2))
  158.         (setq px4 (list tx1 ty2))
  159.         (setq pt_list (list px1 px2 px3 px4))
  160.         (setq tuhao (ssget "cp" pt_list '((0 . "TEXT"))))
  161.         ;获得名称的四个坐标
  162.         (setq mx1 (- maxx (* scl 122)))
  163.         (setq my1 (+ miny (* scl 10)))
  164.         (setq mx2 (- maxx (* scl 62)))
  165.         (setq my2 (+ miny (* scl 28)))
  166.         (setq px5 (list mx1 my1))
  167.         (setq px6 (list mx2 my1))
  168.         (setq px7 (list mx2 my2))
  169.         (setq px8 (list mx1 my2))
  170.         (setq pt_list1 (list px5 px6 px7 px8))
  171.         (setq mingcheng (ssget "cp" pt_list1 '((0 . "TEXT"))))
  172.         ;获得图号
  173.         (setq tuhao_name (ssname tuhao 0))
  174.         (setq tuhao_data (entget tuhao_name))
  175.         (setq tuhao_name1 (assoc 1 tuhao_data))
  176.         (setq tuhao_name1 (cdr tuhao_name1))
  177.         ;获得名称
  178.         (setq mingcheng_name (ssname mingcheng 0))
  179.         (setq mingcheng_data (entget mingcheng_name))
  180.         (setq mingcheng_name1 (assoc 1 mingcheng_data))
  181.         (setq mingcheng_name1 (cdr mingcheng_name1))
  182.         (list tuhao_name1 mingcheng_name1)
  183. )
  184. (defun a3a4name (maxx miny / mingcheng mingcheng_data mingcheng_name mingcheng_name1 mx1 mx2 my1 my2 pt_list pt_list1 px1 px2 px3 px4 px5 px6 px7 px8 tuhao tuhao_data tuhao_name tuhao_name1 tx1 tx2 ty1 ty2)
  185.         (setq tx1 (- maxx (* scl 49)))
  186.         (setq ty1 (+ miny (* scl 5)))
  187.         (setq tx2 (- maxx (* scl 5)))
  188.         (setq ty2 (+ miny (* scl 15)))
  189.         (setq px1 (list tx1 ty1))
  190.         (setq px2 (list tx2 ty1))
  191.         (setq px3 (list tx2 ty2))
  192.         (setq px4 (list tx1 ty2))
  193.         (setq pt_list (list px1 px2 px3 px4))
  194.         (setq tuhao (ssget "cp" pt_list '((0 . "TEXT"))))
  195.         ;获得名称的四个坐标
  196.         (setq mx1 (- maxx (* scl 117)))
  197.         (setq my1 (+ miny (* scl 5)))
  198.         (setq mx2 (- maxx (* scl 57)))
  199.         (setq my2 (+ miny (* scl 23)))
  200.         (setq px5 (list mx1 my1))
  201.         (setq px6 (list mx2 my1))
  202.         (setq px7 (list mx2 my2))
  203.         (setq px8 (list mx1 my2))
  204.         (setq pt_list1 (list px5 px6 px7 px8))
  205.         (setq mingcheng (ssget "cp" pt_list1 '((0 . "TEXT"))))
  206.         ;获得图号
  207.         (setq tuhao_name (ssname tuhao 0))
  208.         (setq tuhao_data (entget tuhao_name))
  209.         (setq tuhao_name1 (assoc 1 tuhao_data))
  210.         (setq tuhao_name1 (cdr tuhao_name1))
  211.         ;获得名称
  212.         (setq mingcheng_name (ssname mingcheng 0))
  213.         (setq mingcheng_data (entget mingcheng_name))
  214.         (setq mingcheng_name1 (assoc 1 mingcheng_data))
  215.         (setq mingcheng_name1 (cdr mingcheng_name1))
  216.         (list tuhao_name1 mingcheng_name1)
  217. )
  218. ;;;字符替换程序
  219. (defun zifutihuan (zifu )
  220.         (while (vl-string-search "/" zifu)
  221.     (setq zifu (vl-string-subst "." "/" zifu))
  222.   )
  223.         (while (vl-string-search "\\" zifu)
  224.     (setq zifu (vl-string-subst "." "\\" zifu))
  225.   )
  226.         (while (vl-string-search "-" zifu)
  227.     (setq zifu (vl-string-subst "." "-" zifu))
  228.   )
  229.         (while (vl-string-search "Ⅱ" zifu)
  230.     (setq zifu (vl-string-subst "II" "Ⅱ" zifu))
  231.   )
  232.         (while (vl-string-search "Ⅰ" zifu)
  233.     (setq zifu (vl-string-subst "I" "Ⅰ" zifu))
  234.   )
  235.         
  236.         zifu        
  237. )
  238. (defun pdfplot (st p1 p2 tufu lujing / dayinji)
  239.         (setq dayinji "dwg to pdf.pc3")
  240.   
  241.   (command "-plot" "y"         ; 是否需要详细打印配置
  242.                 "模型"           ; 输入布局、模型名称
  243.                 dayinji         ; 输入输出设备的名称  此处例举虚拟打印机 pdfFactory Pro
  244.                 ; (lisp语言中的一个 \ 符号需要用 \\符号表示，即\=>\\)
  245.                 ; 例如：共享打印机 \\Adminstractor\Kyocera KM-2560 KX应该表示为\\\\Adminstractor\\Kyocera KM-2560 KX
  246.                 tufu           ; 输入图纸尺寸A4
  247.                 "m"           ; 输入图纸单位(I:英寸 M:毫米)
  248.                 st           ; 输入图形方向(纵向:P 横向)
  249.                 "n"           ; 是否反向打印
  250.                 "w"           ; 输入打印区域(显示:D范围:E图形界限 视图:V 窗口:W)
  251.                 p1                   ; 打印图框左下角点坐标
  252.                 p2                   ; 打印图框右上角点坐标
  253.                 "f"           ; 输入打印比例(F:布满)
  254.                 "c"           ; 输入打印偏移(居中打印:C)
  255.                 "y"           ; 是否按样式打印
  256.                 "22.ctb"           ; 输入打印样式名称
  257.                 "y"           ; 是否打印线宽
  258.                 "a"           ; 输入着色打印设置(按显示:A 线框:W
  259.                 ; 消隐:H 渲染:R)
  260.                 lujing          ; 是否打印到文件
  261.                 "n"           ; 是否保存对页面设置的修改
  262.                 "y"           ; 是否继续打印
  263.         )
  264. )
回复 支持 反对

使用道具 举报

dd131028
发表于 2020-6-17 15:37 | 显示全部楼层

就加了一小段

本帖最后由 dd131028 于 2020-6-17 15:44 编辑
war32 发表于 2020-6-15 20:33
代码发上来看看？

((= cw_d_Specifications "A0")
(progn (setq  cw_right_pt    (polar cw_leftdown_pt 0 (* 1189 cw_read_draw_times)))
        (setq  cw_true_corner (polar cw_right_pt  (/ pi 2) (* 841 cw_read_draw_times)))))     
((= cw_d_Specifications "A1")
(progn (setq  cw_right_pt    (polar cw_leftdown_pt 0 (* 841 cw_read_draw_times)))
        (setq  cw_true_corner (polar cw_right_pt  (/ pi 2) (* 594 cw_read_draw_times)))))
((= cw_d_Specifications "A2")
(progn (setq  cw_right_pt    (polar cw_leftdown_pt 0 (* 594 cw_read_draw_times)))
        (setq  cw_true_corner (polar cw_right_pt  (/ pi 2) (* 420 cw_read_draw_times)))))
回复 支持 反对

使用道具 举报

myfrankie
发表于 2015-11-6 17:22 | 显示全部楼层
如何将图块名改为自定义的名称？
回复 支持 反对

使用道具 举报

winerfjy
发表于 2015-11-6 22:48 来自手机 | 显示全部楼层
myfrankie 发表于 2015-11-6 17:22
如何将图块名改为自定义的名称？

辛苦了！做个程序真心不易
回复 支持 反对

使用道具 举报

war32
 楼主| 发表于 2015-11-7 08:12 | 显示全部楼层
myfrankie 发表于 2015-11-6 17:22
如何将图块名改为自定义的名称？

可以改，但是图块名必须有可以区分图幅的字样才可以，我目前做的规定图块名必须带A1、A2、A3、A4，你可以把这些改成其他的特征字符，但必须可以通过这些识别图幅，例如你可以把大写的A换成a
回复 支持 反对

使用道具 举报

F4164789
发表于 2015-11-7 09:30 | 显示全部楼层
程序真的不错，设计个程序真的不容易
回复 支持 反对

使用道具 举报

sicky111
发表于 2015-11-7 10:34 | 显示全部楼层
有点意思   
回复 支持 反对

使用道具 举报

冰之绝恋
发表于 2015-11-7 11:05 | 显示全部楼层
程序真的不错，设计个程序真的不容易
回复 支持 反对

使用道具 举报

ps122hb
发表于 2015-11-10 08:32 | 显示全部楼层
不错，多谢分享
回复 支持 反对

使用道具 举报

438682112
发表于 2015-11-10 16:22 | 显示全部楼层
谢谢分享， 支持
回复 支持 反对

使用道具 举报

12345下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-4-25 12:55 , Processed in 0.310145 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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