智能批量打印程序

依然小小鸟 · 发表于 2017-12-26 13:28:16

水吉空发表于 2017-12-22 18:07

又想拿别人开发的快刀批量打印卖钱？你到底尊不尊重版权

w245272914 · 发表于 2017-12-26 13:54:11

依然小小鸟发表于 2017-12-26 13:28
又想拿别人开发的快刀批量打印卖钱？你到底尊不尊重版权

兄弟，谢谢提醒 ^^
你有这种程序吗？可以共享给我吗、感谢你了
Y10086520@163.com

行行止 · 发表于 2017-12-26 17:59:44

先下载学习一下

行行止 · 发表于 2017-12-27 08:45:20

ygp820601 发表于 2017-12-26 10:58
注释的中文都是乱码？

;;需建立打印每幅图范围多段线图框及编号，并且令其处同一图层
;;主程序
(defun c:sxdy ( / cmd doc e2 el2 i i2 itm lst lst1 lst2 msg n os p1 p3 sgel ss1 ss2 tc xy)
(defun *error* (msg)
(setvar "cmdecho" cmd) ;_ 恢复cmdecho系统变量
(setvar "osmode" os) ;_ 恢复osmode系统变量
(princ "error: ")
(princ msg) ;_ 打印错误信息
(princ)
)
(setq cmd (getvar "cmdecho")) ;_ 保存系统变量cmdecho值
(setq os (getvar "osmode"))
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-StartUndoMark doc)
(setvar "osmode" 0)
(setq tc (assoc 8 (entget (car (entsel "\n 请选任选一打印序号==>> ")))))
(command "-layer" "p" "n" (cdr tc) "")
(print "\n 请选择需要打印的范围的图框==>>")
;同时获取图框选择集ss1 文字选择集ss2
(setq ss1 nil ss2 nil)
(if (setq ss1 (ssget (list (cons 0 "TEXT,LWPOLYLINE") tc)))
(foreach itm (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
(if (= (cdr (assoc 0 (entget itm))) "TEXT")
(progn
(or ss2 (setq ss2 (ssadd)))
(ssadd itm ss2)
(ssdel itm ss1)
)
)
)
)
(setq i2 0)
(setq lst2 nil)
(repeat (sslength ss2)
(setq e2 (ssname ss2 i2))
(setq el2 (entget e2))
(setq lst2 (append lst2 (list (list (read (cdr (assoc 1 el2))) (assoc 10 el2)))))
(setq i2 (1+ i2))
)
(setq lst2 (sort lst2)) ;;已经按图框内数字1,2,3,4进行排序的表lst2 ((序号1 (10 三维点)) (序?2 (10 三号)))
(setq lst2 (vl lst2)) ;;去掉lst2中的序号，重组序号表 lst2
(lstlw ss1) ;; 得到图框角点坐标表lst1
(setq n 0)
(setq lst nil)
(repeat (length lst2)
(setq sgel (nth n lst2)) ;;获取单个序号坐坐标
(setq lst (append lst (pp sgel lst1))) ;;得到对应图框坐标表
(setq n (1+ n))
)
(setq i 0)
(repeat (length lst)
(setq xy (nth i lst))
(setq p1 (car xy))
(setq p3 (cadr (cdr xy)))
(command "zoom" "w" p1 p3)
(command "-plot" "y" ; 是否需要详细打印配置
"模型" ; 输入布局、模型名称
"pdfFactory Pro" ; 输入输出设备的名称此处举例虚拟打印机 pdfFactory Pro
; (lisp语言中的一个 \ 符号需要用 \\符号表示，即\=>\\)
; 例如：共享打印机 \\Adminstractor\Kyocera KM-2560 KX应该表示为\\\\Adminstractor\\Kyocera KM-2560 KX
"A4" ; 输入图纸尺寸A4
"m" ; 输入图纸单位(I:英寸 M:毫米)
"p" ; 输入图形方向(纵向:P 横向:L )
"n" ; 是否反向打印
"w" ; 输入打印区域(显示:D范围:E图形界限:L 视图:V 窗口:W)
p1 ; 打印图框左下角点坐标
p3 ; 打印图框右上角点坐标
"f" ; 输入打印比例(F:布满)
"c" ; 输入打印偏移(居中打印:C)
"y" ; 是否按样式打印
"monochrome.ctb" ; 输入打印样式名称
"y" ; 是否打印线宽
"a" ; 输入着色打印设置置(按显示:A 线框:W
; 消隐:H 渲染:R)
"n" ; 是否打印到文件
"n" ; 是否保存页面设置的修改
"y" ; 是否继续打印
)
(setq i (+ i 1))
)
(setvar "cmdecho" cmd) ;_ 恢复cmdecho系统变量
(setvar "osmode" os) ;_ 恢复osmode系统变量
(vla-EndUndoMark doc)
(vlax-release-object doc)
(princ)
)
;获取图框集合多段点表总表
(defun lstlw (ss)
(setq i1 0)
(setq lst1 nil)
(repeat (sslength ss)
(setq e1 (ssname ss i1))
(setq el1 (LWPL e1))
(setq lst1 (append lst1 (list el1)))
(setq i1 (1+ i1))
)
)
;获取多段线点表函数
(defun LWPL (x /)
(vl-remove-if
'not
(mapcar
'(lambda (x)
(if (= (car x) 10)
(append (cdr x) '(0))
)
)
(entget x)
)
)
)
;;?((1 (10 1117.07 581.131 0.0)) (2 (10 1693.6 596.47 0.0)))中的序号1 2去掉
(defun vl (lst)
(mapcar '(lambda (x)
(cdr (car (cdr x)))
)
lst
)
)
;;提取出对应单个图框的坐标表
(defun pp (pt lst)
(vl-remove-if
'not
(mapcar
'(lambda (x)
(if (= T (isPtinPM pt x))
x
)
)
lst
)
)
)
;;根据文字内容进行表排序
(defun sort (LST / REC)
(defun REC (A B)
;;递归
(cond ((equal (car A) (car B) 1E-4)
(REC (cdr A) (cdr B))
)
(T (< (car A) (car B)))
)
)
(vl-sort LST '(lambda (P1 P2) (REC P1 P2)))
)
;;eg:((1 (10 1117.07 581.131 0.0)) (2 (10 1693.6 596.47 0.0)) (3 (10 2284.33 603.215 0.0)))
;;;******************************************************************************
;;; No.51 判断点是否在多边形内(狂刀程序)
;;;xPt是要判断的点坐标(x y z ), Points是多边形顶点列表((x1 y1 z1) (x2 y2 z2)...)
;;;******************************************************************************
(defun isPtinPM (xPt Points)
(equal
PI
(abs
(apply
'+
(mapcar '(lambda (x y) (rem (- (angle xPt x) (angle xPt y)) PI))
(reverse (cdr (reverse (cons (last Points) Points))))
Points
)
)
)
1e-6
) ;end_equal
) ;end_defun

;;需建立打印每幅图范围多段线图框及编号，并且令其处同一图层 
;;主程序 
(defun c:sxdy ( / cmd doc e2 el2 i i2 itm lst lst1 lst2 msg n os p1 p3 sgel ss1 ss2 tc xy) 
    (defun *error* (msg) 
    (setvar "cmdecho" cmd) ;_ 恢复cmdecho系统变量 
    (setvar "osmode" os) ;_ 恢复osmode系统变量 
    (princ "error: ") 
    (princ msg) ;_ 打印错误信息 
    (princ) 
  ) 
  (setq cmd (getvar "cmdecho")) ;_ 保存系统变量cmdecho值 
  (setq os (getvar "osmode")) 
  (setq doc (vla-get-activedocument (vlax-get-acad-object))) 
  (vla-StartUndoMark doc) 
  (setvar "osmode" 0) 
  (setq tc (assoc 8 (entget (car (entsel "\n 请选任选一打印序号==>> "))))) 
  (command "-layer" "p" "n" (cdr tc) "") 
  (print "\n 请选择需要打印的范围的图框==>>") 
  ;同时获取图框选择集ss1 文字选择集ss2 
  (setq ss1 nil ss2 nil) 
  (if (setq ss1 (ssget (list (cons 0 "TEXT,LWPOLYLINE") tc))) 
    (foreach itm (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))) 
      (if (= (cdr (assoc 0 (entget itm))) "TEXT") 
        (progn 
          (or ss2 (setq ss2 (ssadd))) 
          (ssadd itm ss2) 
          (ssdel itm ss1) 
        ) 
      ) 
    ) 
  ) 
(setq i2 0) 
(setq lst2 nil) 
(repeat (sslength ss2) 
  (setq e2 (ssname ss2 i2)) 
  (setq el2 (entget e2)) 
  (setq lst2 (append lst2 (list (list (read (cdr (assoc 1 el2))) (assoc 10 el2))))) 
  (setq i2 (1+ i2)) 
  ) 
  (setq lst2 (sort lst2))     ;;已经按图框内数字1,2,3,4进行排序的表lst2 ((序号1 (10 三维点)) (序?2 (10 三号))) 
  (setq lst2 (vl lst2))       ;;去掉lst2中的序号，重组序号表 lst2 
  (lstlw ss1)                 ;; 得到图框角点坐标表lst1          
  (setq n 0) 
  (setq lst nil) 
  (repeat (length lst2) 
    (setq sgel (nth n lst2))   ;;获取单个序号坐坐标 
    (setq lst (append lst  (pp sgel lst1)))  ;;得到对应图框坐标表 
    (setq n (1+ n)) 
    ) 
  (setq i 0) 
  (repeat (length lst) 
    (setq xy (nth i lst)) 
    (setq p1 (car xy)) 
    (setq p3 (cadr (cdr xy))) 
    (command "zoom" "w" p1 p3) 
    (command "-plot" "y"         ; 是否需要详细打印配置 
       "模型"           ; 输入布局、模型名称 
       "pdfFactory Pro"         ; 输入输出设备的名称  此处举例虚拟打印机 pdfFactory Pro 
                                       ; (lisp语言中的一个 \ 符号需要用 \\符号表示，即\=>\\) 
                                 ; 例如：共享打印机 \\Adminstractor\Kyocera KM-2560 KX应该表示为\\\\Adminstractor\\Kyocera KM-2560 KX 
       "A4"          ; 输入图纸尺寸A4 
       "m"           ; 输入图纸单位(I:英寸 M:毫米) 
       "p"           ; 输入图形方向(纵向:P 横向:L  ) 
       "n"           ; 是否反向打印 
       "w"           ; 输入打印区域(显示:D范围:E图形界限:L 视图:V 窗口:W) 
       p1                   ; 打印图框左下角点坐标 
       p3                   ; 打印图框右上角点坐标 
       "f"           ; 输入打印比例(F:布满) 
       "c"           ; 输入打印偏移(居中打印:C) 
       "y"           ; 是否按样式打印 
       "monochrome.ctb"           ; 输入打印样式名称 
       "y"           ; 是否打印线宽 
       "a"           ; 输入着色打印设置置(按显示:A  线框:W 
                     ; 消隐:H 渲染:R) 
       "n"           ; 是否打印到文件 
       "n"           ; 是否保存页面设置的修改 
       "y"           ; 是否继续打印 
    ) 
    (setq i (+ i 1)) 
  ) 
    (setvar "cmdecho" cmd) ;_ 恢复cmdecho系统变量 
  (setvar "osmode" os)   ;_ 恢复osmode系统变量 
  (vla-EndUndoMark doc) 
  (vlax-release-object doc) 
  (princ) 
) 
   
;获取图框集合多段点表总表 
(defun lstlw (ss) 
  (setq i1 0) 
  (setq lst1 nil) 
  (repeat (sslength ss) 
    (setq e1 (ssname ss i1)) 
    (setq el1 (LWPL e1)) 
    (setq lst1 (append lst1 (list el1))) 
    (setq i1 (1+ i1)) 
  ) 
) 
;获取多段线点表函数 
(defun LWPL (x /) 
  (vl-remove-if 
    'not 
    (mapcar 
      '(lambda (x) 
   (if (= (car x) 10) 
     (append (cdr x) '(0)) 
   ) 
       ) 
      (entget x) 
    ) 
  ) 
) 
 
;;?((1 (10 1117.07 581.131 0.0)) (2 (10 1693.6 596.47 0.0)))中的序号1 2去掉 
 (defun  vl (lst) 
   (mapcar '(lambda (x) 
        (cdr (car (cdr x))) 
      ) 
     lst 
   ) 
 ) 
 
;;提取出对应单个图框的坐标表 
(defun pp (pt lst) 
  (vl-remove-if 
    'not 
    (mapcar 
      '(lambda (x) 
   (if (= T (isPtinPM pt x)) 
     x 
   ) 
       ) 
      lst 
    ) 
  ) 
) 
;;根据文字内容进行表排序 
(defun sort (LST / REC) 
  (defun REC (A B) 
    ;;递归 
    (cond ((equal (car A) (car B) 1E-4) 
     (REC (cdr A) (cdr B)) 
    ) 
    (T (< (car A) (car B))) 
    ) 
  ) 
  (vl-sort LST '(lambda (P1 P2) (REC P1 P2))) 
) 
;;eg:((1 (10 1117.07 581.131 0.0)) (2 (10 1693.6 596.47 0.0)) (3 (10 2284.33 603.215 0.0))) 
;;;****************************************************************************** 
;;; No.51  判断点是否在多边形内(狂刀程序)                                        
;;;xPt是要判断的点坐标(x y z ), Points是多边形顶点列表((x1 y1 z1) (x2 y2 z2)...) 
;;;****************************************************************************** 
(defun isPtinPM  (xPt Points) 
  (equal 
    PI 
    (abs 
      (apply 
  '+ 
  (mapcar  '(lambda (x y) (rem (- (angle xPt x) (angle xPt y)) PI)) 
    (reverse (cdr (reverse (cons (last Points) Points)))) 
    Points 
  ) 
      ) 
    ) 
    1e-6 
  )          ;end_equal 
)          ;end_defun

翻译了一下

lostbalance · 发表于 2017-12-27 09:06:47

最近正好也在研究这块。
1. 关于打印方向的问题，command plot里就有一个参数控制的（P/L），你的注释里就有。所以可以设置一个参数dir，在打印前，可以先根据p1和p3，判断dir是P还是L，然后在command里用dir来控制就可以。
2. 另外关于pdf位置，如果用的是07版以上的CAD的话，用自带的DWG TO PDF.pc3来设置路径比较方便。
3. 当前dwg文件的路径用(getvar "dwgprefix")获得

行行止 · 发表于 2017-12-27 11:36:07

lostbalance 发表于 2017-12-27 09:06
最近正好也在研究这块。
1. 关于打印方向的问题，command plot里就有一个参数控制的（P/L），你的注释里就 ...

请教一下，关于第二点提到的位置，具体应该怎样设置呢？

这个困扰了好久，每次都是先手动用一下DWG TO PDF.pc3一次，确定了位置再批量转PDF，好麻烦。

cq_qg · 发表于 2017-12-27 12:55:40

里面怎么是乱码？

lostbalance · 发表于 2017-12-27 14:57:34

本帖最后由 lostbalance 于 2017-12-27 15:03 编辑

行行止发表于 2017-12-27 11:36
请教一下，关于第二点提到的位置，具体应该怎样设置呢？
这个困扰了好久，每次都是先手动 ...

用上面第3条提到的dwgprefix获取当前文件夹路径，是个字符串，类似"c://test"，然后确定pdf的名字，比如"a.pdf"，把路径和文件名合并成一个字符串str，然后在用command plot打印的代码中修改使用就可以。
补充下：关于command plot，我编程序的时候发现，根据打印成品的不同，格式有变化。
1. 用CAD的打印机DWG TO PDF.PC3，在设置打印到文件时，直接用路径地址（含文件名），不需要加y/n；
2. 打印PLT时，在设置打印到文件时，要先输入y，然后加路径地址；
3. 用其他的打印机打图纸或PDF时，在设置打印到文件时，输入n；
4. 打印图片格式等之类的，因为没怎么用过，不清楚了
以下是我编的打印插件里的，你可以看着参考下。ps，我的在设置方向的时候单独加了A2图纸的判断是公司这边打印机的关系。
(setq xd (abs (- (car p1) (car p2))))
(setq yd (abs (- (cadr p1) (cadr p2))))
(cond
((and sc (equal (* xd 1. sc) 420 20) (equal (* yd 1. sc) 594 20))
      (setq dir "L")
)
((and sc (equal (* xd 1. sc) 594 20) (equal (* yd 1. sc) 420 20))
      (setq dir "P")
)
((>= xd yd)
      (setq dir "L")
)
(t
      (setq dir "P")
)
)
(command
"._plot"
"y"    ;;详细配置
""    ;;模型或布局名
prt_n ;;打印机
paper_n ;;图纸尺寸
"m"    ;;单位，英寸I/毫米M
dir    ;;打印方向，纵向P/横向L
"n"    ;;颠倒打印，Y/N
"w"    ;;打印区域，窗口W
"_non" p1
"_non" p2
)
(if sc
(command
      (rtos sc) ;;打印比例，或布满F
      "0,0"    ;;打印偏移，或居中C
)
(command
      "f"    ;;打印比例，或布满F
      "c"    ;;打印偏移，或居中C
)
)
(command
"y" ;;是否按打印样式，Y/N
ctb ;;样式表
"y" ;;打印线宽，Y/N
"w" ;;着色打印，传统线框W
)
(cond ;;打印到文件，Y/N
((and (= prt 1) (= (strcase prt_n) "DWG TO PDF.PC3"))
      (command (strcat path "\\done\\" (add_fn_no) ".pdf"))
)
((= prt 2)
      (command "y" (strcat path "\\done\\" (add_fn_no) ".plt"))
)
(t
      (command "n")
)
)
(command
"n" ;;保存设置,Y/N
"y" ;;是否打印，Y/N
)

行行止 · 发表于 2017-12-28 08:05:57

本帖最后由行行止于 2017-12-28 08:07 编辑

lostbalance 发表于 2017-12-27 14:57
用上面第3条提到的dwgprefix获取当前文件夹路径，是个字符串，类似"c://test"，然后确定pdf的名字，比如" ...

原来还可以把命令这样拆分的啊，不仅解决了我之前的问题，还打开了一条没发现的新路，真的万分感谢！

w245272914 · 发表于 2017-12-28 10:23:07

行行止发表于 2017-12-27 08:45
翻译了一下

谢谢大神~ :

账号		自动登录	找回密码
密码			注册

[源码] 智能批量打印程序