智能批量打印程序

w245272914

各位大神走过路过，请不要错过！！进来看一看瞧一瞧，吃不了亏上不了当，啦啦啦~~~~
不良原因：附件是lisp程序与模版DWG
该程序有一个缺点不能智能识别打印纵向或者横向的图纸
在程序中设置了 （     "p"           ; 輸入圖形方向(縱向:P 橫向  )
只能縱向打印，而有些图纸是有纵向与横向的
所以：
跪求改一批量打印程序
可以帮忙优化该程序吗，那些不合理的函数，那些重复的函数，那些可以简化的函数
可以帮忙优化成更智能吗？智能打印縱向:P 橫向，并自动保存PDF到该文件目录就更好了

war32
首先感谢这位大神帮忙修模程序，可以智能打印縱向:P 橫向
见程序源码：智能判斷模型空間橫縱_批量打印（源码共享给大家使用）
一、不过问题又来了，能在请大神帮忙实现智能打印縱向:P 橫向（已经实现 ），并自动保存PDF到该文件目录就更好了（程序没实现）
二、可以实现多dwg自动打印PDF到工作目录（程序没实现）
lostbalance
又来感谢 ~~~
不厌其烦是教导我一步步调试，太感谢了。最终程序测试OK
程序：智能判斷模型空間橫縱_批量打印(DWG To PDF.pc3)
说明：目前只适用CAD本身打印机DWG To PDF.pc3，读取模型空间中的一张张图纸，自动保存为一张张图纸到该文件目录。
顺带问题点：
我喜欢用pdfFactory Pro 打机印，打印质量好，可以用什么函数自动保存到该文件目录吗？

w245272914

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

注释，我以为你们可以直接看的懂。55    我们公司是台资产。所以乱码。你试着改改，不行的话，我想办法上传简体的。

lostbalance

w245272914 发表于 2018-1-8 08:51
哥们，你上次也说过该段代码只适用于DWG To PDF.pc3打印机，而不适用pdfFactory Pro打印机
(if ( ...

你说的是合成一个PDF文件吗，那自带的那个好像是不可以吧。不过个人习惯一张图一个PDF，所以对这个就不了解了。ps，公司买了正版Adobe PDF，那个带有做合集功能，偶尔要用也没关系，哈哈。
如果用第三方那个打印机，那我改的代码就基本不能用了。command前面的都可以删了。然后后面打印到文件那个[path]恢复成["n"]。
以为是Adobe PDF打印机的示例：
1. AutoCAD的添加打印机，添加一个Adobe PDF打印机的pc3副本，然后配置这个pc3副本，自定义特性里面把查看PDF结果关闭，然后输出文件夹改为默认Documents\*.pdf。然后用自带的打印功能随便打印一张，看看出来的pdf文件名称是什么，比如["e://desktop//1model.pdf"]。
2. 用上述修改完的代码。然后在后面加上pdf改名的代码，
(vl-file-rename "e://desktop//1model.pdf" "e://desktop//new.pdf")
(vl-file-copy "e://desktop//new.pdf" "e://work//new.pdf")
(vl-file-delete "e://desktop//new.pdf")
然后如果批量的，考虑加入序号[No]之类的。
大概是这样的代码吧，我没用过，你可以测试下。
不过个人感觉兼容性比较差，至少默认的pdf文件名，中英文环境下就不一致，知道的还可以多加几组判断，不知道的就没办法了。

行行止

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

2. ;;需建立打印每幅图范围多段线图框及编号，并且令其处同一图层
   
3. ;;主程序
   
4. (defun c:sxdy ( / cmd doc e2 el2 i i2 itm lst lst1 lst2 msg n os p1 p3 sgel ss1 ss2 tc xy)
   
5.     (defun *error* (msg)
   
6.     (setvar "cmdecho" cmd) ;_ 恢复cmdecho系统变量
   
7.     (setvar "osmode" os) ;_ 恢复osmode系统变量
   
8.     (princ "error: ")
   
9.     (princ msg) ;_ 打印错误信息
   
10.     (princ)
    
11.   )
    
12.   (setq cmd (getvar "cmdecho")) ;_ 保存系统变量cmdecho值
    
13.   (setq os (getvar "osmode"))
    
14.   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
    
15.   (vla-StartUndoMark doc)
    
16.   (setvar "osmode" 0)
    
17.   (setq tc (assoc 8 (entget (car (entsel "\n 请选任选一打印序号==>> ")))))
    
18.   (command "-layer" "p" "n" (cdr tc) "")
    
19.   (print "\n 请选择需要打印的范围的图框==>>")
    
20.   ;同时获取图框选择集ss1 文字选择集ss2
    
21.   (setq ss1 nil ss2 nil)
    
22.   (if (setq ss1 (ssget (list (cons 0 "TEXT,LWPOLYLINE") tc)))
    
23.     (foreach itm (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
    
24.       (if (= (cdr (assoc 0 (entget itm))) "TEXT")
    
25.         (progn
    
26.           (or ss2 (setq ss2 (ssadd)))
    
27.           (ssadd itm ss2)
    
28.           (ssdel itm ss1)
    
29.         )
    
30.       )
    
31.     )
    
32.   )
    
33. (setq i2 0)
    
34. (setq lst2 nil)
    
35. (repeat (sslength ss2)
    
36.   (setq e2 (ssname ss2 i2))
    
37.   (setq el2 (entget e2))
    
38.   (setq lst2 (append lst2 (list (list (read (cdr (assoc 1 el2))) (assoc 10 el2)))))
    
39.   (setq i2 (1+ i2))
    
40.   )
    
41.   (setq lst2 (sort lst2))     ;;已经按图框内数字1,2,3,4进行排序的表lst2 ((序号1 (10 三维点)) (序?2 (10 三号)))
    
42.   (setq lst2 (vl lst2))       ;;去掉lst2中的序号，重组序号表 lst2
    
43.   (lstlw ss1)                 ;; 得到图框角点坐标表lst1         
    
44.   (setq n 0)
    
45.   (setq lst nil)
    
46.   (repeat (length lst2)
    
47.     (setq sgel (nth n lst2))   ;;获取单个序号坐坐标
    
48.     (setq lst (append lst  (pp sgel lst1)))  ;;得到对应图框坐标表
    
49.     (setq n (1+ n))
    
50.     )
    
51.   (setq i 0)
    
52.   (repeat (length lst)
    
53.     (setq xy (nth i lst))
    
54.     (setq p1 (car xy))
    
55.     (setq p3 (cadr (cdr xy)))
    
56.     (command "zoom" "w" p1 p3)
    
57.     (command "-plot" "y"         ; 是否需要详细打印配置
    
58.        "模型"           ; 输入布局、模型名称
    
59.        "pdfFactory Pro"         ; 输入输出设备的名称  此处举例虚拟打印机 pdfFactory Pro
    
60.                                        ; (lisp语言中的一个 \ 符号需要用 \\符号表示，即\=>\\)
    
61.                                  ; 例如：共享打印机 \\Adminstractor\Kyocera KM-2560 KX应该表示为\\\\Adminstractor\\Kyocera KM-2560 KX
    
62.        "A4"          ; 输入图纸尺寸A4
    
63.        "m"           ; 输入图纸单位(I:英寸 M:毫米)
    
64.        "p"           ; 输入图形方向(纵向:P 横向:L  )
    
65.        "n"           ; 是否反向打印
    
66.        "w"           ; 输入打印区域(显示:D范围:E图形界限:L 视图:V 窗口:W)
    
67.        p1                   ; 打印图框左下角点坐标
    
68.        p3                   ; 打印图框右上角点坐标
    
69.        "f"           ; 输入打印比例(F:布满)
    
70.        "c"           ; 输入打印偏移(居中打印:C)
    
71.        "y"           ; 是否按样式打印
    
72.        "monochrome.ctb"           ; 输入打印样式名称
    
73.        "y"           ; 是否打印线宽
    
74.        "a"           ; 输入着色打印设置置(按显示:A  线框:W
    
75.                      ; 消隐:H 渲染:R)
    
76.        "n"           ; 是否打印到文件
    
77.        "n"           ; 是否保存页面设置的修改
    
78.        "y"           ; 是否继续打印
    
79.     )
    
80.     (setq i (+ i 1))
    
81.   )
    
82.     (setvar "cmdecho" cmd) ;_ 恢复cmdecho系统变量
    
83.   (setvar "osmode" os)   ;_ 恢复osmode系统变量
    
84.   (vla-EndUndoMark doc)
    
85.   (vlax-release-object doc)
    
86.   (princ)
    
87. )
    
88.   
    
89. ;获取图框集合多段点表总表
    
90. (defun lstlw (ss)
    
91.   (setq i1 0)
    
92.   (setq lst1 nil)
    
93.   (repeat (sslength ss)
    
94.     (setq e1 (ssname ss i1))
    
95.     (setq el1 (LWPL e1))
    
96.     (setq lst1 (append lst1 (list el1)))
    
97.     (setq i1 (1+ i1))
    
98.   )
    
99. )
    
100. ;获取多段线点表函数
     
101. (defun LWPL (x /)
     
102.   (vl-remove-if
     
103.     'not
     
104.     (mapcar
     
105.       '(lambda (x)
     
106.    (if (= (car x) 10)
     
107.      (append (cdr x) '(0))
     
108.    )
     
109.        )
     
110.       (entget x)
     
111.     )
     
112.   )
     
113. )
     
114. 
     
115. ;;?((1 (10 1117.07 581.131 0.0)) (2 (10 1693.6 596.47 0.0)))中的序号1 2去掉
     
116. (defun  vl (lst)
     
117.    (mapcar '(lambda (x)
     
118.         (cdr (car (cdr x)))
     
119.       )
     
120.      lst
     
121.    )
     
122. )
     
123. 
     
124. ;;提取出对应单个图框的坐标表
     
125. (defun pp (pt lst)
     
126.   (vl-remove-if
     
127.     'not
     
128.     (mapcar
     
129.       '(lambda (x)
     
130.    (if (= T (isPtinPM pt x))
     
131.      x
     
132.    )
     
133.        )
     
134.       lst
     
135.     )
     
136.   )
     
137. )
     
138. ;;根据文字内容进行表排序
     
139. (defun sort (LST / REC)
     
140.   (defun REC (A B)
     
141.     ;;递归
     
142.     (cond ((equal (car A) (car B) 1E-4)
     
143.      (REC (cdr A) (cdr B))
     
144.     )
     
145.     (T (< (car A) (car B)))
     
146.     )
     
147.   )
     
148.   (vl-sort LST '(lambda (P1 P2) (REC P1 P2)))
     
149. )
     
150. ;;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)))
     
151. ;;;******************************************************************************
     
152. ;;; No.51  判断点是否在多边形内(狂刀程序)                                       
     
153. ;;;xPt是要判断的点坐标(x y z ), Points是多边形顶点列表((x1 y1 z1) (x2 y2 z2)...)
     
154. ;;;******************************************************************************
     
155. (defun isPtinPM  (xPt Points)
     
156.   (equal
     
157.     PI
     
158.     (abs
     
159.       (apply
     
160.   '+
     
161.   (mapcar  '(lambda (x y) (rem (- (angle xPt x) (angle xPt y)) PI))
     
162.     (reverse (cdr (reverse (cons (last Points) Points))))
     
163.     Points
     
164.   )
     
165.       )
     
166.     )
     
167.     1e-6
     
168.   )          ;end_equal
     
169. )          ;end_defun
     
170. 
     

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

翻译了一下

w245272914

自古帖子楼主顶~~~~~

水吉空

w245272914

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

可以分享LISP吗？   谢谢  哥们

hnzkhyyl

没有源码，你让别人怎么给你修改？？

ps122hb

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

这个应该不是lisp

w245272914

hnzkhyyl 发表于 2017-12-22 23:15
没有源码，你让别人怎么给你修改？？

上面 的附件就是源码啊~~~   有一个lisp   有一个测试文件的。

w245272914

200多个查看，就是没有人大神来帮忙下  555  

ygp820601

注释的中文都是乱码？