针对PCCD的《批量打印程序》v5.3源码
几年前编了这个程序，有很多人跟我要源码，现在传上来。源码很多都是用了明经的，还有各位老大的帮忙。因为自己只会一点lisp，所以程序编的冗长凌乱。使用清华天河PCCAD绘制的图纸程序进行了专门设计打印效果尤佳，普通CAD绘制的图纸也可使用本程序。2 批量打印2.1 功能针对模型空间图纸，本程序具有三种打印模式。Ø 模式1：对同一目录下(不含子目录，子目录内图纸不打印)多张DWG图纸(每个DWG一张图纸的情况)进行批量打印。Ø 模式2：同一DWG文件内绘制的多幅图纸进行批量打印。Ø 模式3：打印小纸张拼大图功能。使用清华天河PCCAD绘制的图纸程序进行了专门设计打印效果尤佳，普通CAD绘制的图纸也可使用本程序。2.2 模式1批量打印：适用于同一目录下多张DWG图纸2.2.1操作：打开目录下任意一张图纸，只能打开一张，否则出错。启动对话框2.2.2设置打印机、打印样式和打印墨盒里的纸张：Ø A３A４：自动将横式图幅用A3纸张打印，竖式图幅用A４纸张打印（ＨＰ打印机）。Ø A４： 无论图幅横竖与大小，将所有批打的图纸都用A４纸张打印。Ø A３： 无论图幅横竖与大小，将所有批打的图纸都用A3纸张打印。Ø 其它类似。2.2.3将需要打印的图纸添加到“批量打印图纸列表”，通过按钮调整打印顺序。2.2.4在确认上述设置完全正确后，按“批量打印”按钮，即可进行批量打印。在批量打印过程中请勿对计算机进行其它操作以防程序出错。2.3 模式2批量打印：适用于同一DWG文件内绘制的多幅图纸进行批量打印。2.3.1 操作：模式1界面下，右上角的“模式>”按钮可将打印模式切换到模式2。2.3.2 模式2批量打印必须需设置打印区域，设置打印区域可采用三种方法：Ø 手工绘制打印区域：手工点取每一张打印图框的对角顶点作为打印区域。Ø 选取图纸框图块：如图框为块，可采用此方法快速生成打印区域。选取任何一个图框块，程序会将本图中所有具有相同块名的图框设置成打印区域。Ø 指定图层矩形。如图框是绘制在某一图层的封闭矩形，可采用此方法。选取任何一个图框矩形，程序会将本图中所有在该图层的封闭矩形设置成打印区域。2.2.3打印区域设置完成后，按“批量打印”按钮进行批量打印。2.4 模式3批量打印： 适用于打印小纸张拼大图功能。打开一张图纸，例如是想打印成A1的图纸，可是身边没有A1的打印机，只有A3的打印机，这时，打印设置选择：打印 “A3”纸拼成“A1”,按“打印”按钮，则程序自动计算打印区域，打印出4张A3的纸张，用这4张A3的纸张通过胶水可以拼成一张你想要的那张A1的图纸。注意：由于小图纸打印边界问题，拼成的那张A1的图纸比真正的A1图纸略小一些。目前这个程序只能做到这一步，也没有其它的办法。2.4.1 操作：模式2界面下，右上角的“模式>”按钮可将打印模式切换到模式3。2.4.2 对话框说明：Ø “裁剪余量”：是设置打印好后裁剪小纸张拼大图时预留的允许剪切误差，使得拼图美观。Ø “自动”：大图外框的识别可采用“自动”由程序甄别，如识别不理想，可采用“窗口”方式手工指定。Ø “预览”：设置好后先看看拼图的效果和顺序了。
终于把这好家伙顶出来了 langjs 发表于 2018-1-11 23: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)))
;由p1和p3坐標判斷是縱向還是橫向
(if (> (cadr p1) (cadr p3)) (setq p4 p1
p1 (list (car p1) (cadr p3) 0)
p3 (list (car p3) (cadr p4) 0)))
(setq x1 (car p1) y1 (cadr p1) x2 (car p3) y2 (cadr p3))
(setq x (abs (- x1 x2)) y (abs (- y1 y2)) )
(if (> y x) (setq st "p") (setq st "l"))
(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:毫米)
st ; 輸入圖形方向(縱向: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去掉
(defunvl (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
kpl 发表于 2021-5-13 14:23
为何我下载后压缩文件破坏
论坛下载的附件如果无法解压，请用修复软件修复
有baitang36大神的汇编版：http://bbs.mjtd.com/thread-182499-1-1.html
highflybird大神C++版：http://bbs.mjtd.com/forum.php?mod=viewthread&tid=182515&highlight=%D0%DE%B8%B4
tryhi大神的lisp版：http://bbs.mjtd.com/thread-182474-1-1.html
感谢各位大神 本帖最后由 lucas_3333 于 2014-9-16 20:15 编辑
郎大师的程序一定要支持！
郎大师的程序不仅都是经典，而且都是源码，这都是明经巨大的财富！大师的人品更是值得我们大家学习的！
在这里引用E大的一席话：
支持分享源码，因为源码，才有机会看到更优秀的源码，源码可以借鉴，也可以再升华，可以写出更优秀的源码。
关于版主提议，个人觉得没有必要，论坛是自由的，没有权限之分，无论是初级会员，还是高级会员，都是来交流学习的，都有可能遇到自己解决不了的问题或困惑，在论坛里提出来，大家可以一起来解决，我希望大家有源码的都发源码，形成良好的循环，对于某些问题，可以提出来，也可以自己根据坛子的童鞋思路，局部代码，自己研究解决，我更期望各位坛友自己解决，因为你解决了一个问题，才能更深入的了解lisp，以后遇到的问题都会迎刃而解，提出问题->分析问题->解决问题。
各位坛友共勉之。
精品，源码，先给个赞，再慢慢欣赏程序！ 弹出对话框，找不到PLDY1的定义？ 大师的作品，先支持再说。不知道与邱大侠的相比如何... 精品，向langjs致敬 精品，向langjs致敬,学习学习 郎大师的程序一定要支持 来学习的~
感谢分享~