【原创】用纯lisp实现打印任意尺寸pdf

gbbestway

CAD2024貌似不支持ADOBE PDF打印任意尺寸的PDF了, 自定义尺寸不行. 自定尺寸以后, 还是A4的, 具体如下图所示,   哪位用2024的大神帮忙测试一下看看?

flowerson

太厉害了。不知道大侠可以不可以告诉我们lisp读写.pmp和.pc3文件的方法呢？

zhang007

以前一直没找到自定义打印纸张任意尺寸的方法，就用了个最笨的方法，在一台电脑上设置了大量能用得着的自定义纸张，然后把DWG To PDF.pmp、DWG To PDF.pc3拷贝到其他电脑上，再用程序寻找大小最接近的纸张来实现自动出图

baitang36

zhang007 发表于 2024-2-23 09:01
以前一直没找到自定义打印纸张任意尺寸的方法，就用了个最笨的方法，在一台电脑上设置了大量能用得着的自定 ...

我用的是根据图的大小去修改这两个文件。你的办法是准备很多双鞋，我的是根据脚的大小去做鞋，一双就够了。

mj0000

感谢作者研究。昨天折腾了一天，也实现了自定义任意纸张尺寸。办法是直接用作者的函数生成pc3和pmp文件，读成表，修改尺寸参数，再写入pc3和pmp文件，直接就可以用了。刚开始还研究怎么解包打包，后来发现把文件格式直接改Unix格式就行，又研究怎么改格式，找一圈都没发现lisp有这方面资料，死马当活马，直接读文件为表，再写表，就是Unix文件了，直接就能用了。感谢作者分享技术，感谢各位大神研究

陨落

zhang007 发表于 2024-2-23 09:01
以前一直没找到自定义打印纸张任意尺寸的方法，就用了个最笨的方法，在一台电脑上设置了大量能用得着的自定 ...

其实还有第三种思路：裁剪pdf，效果也不差。。

baitang36

mj0000 发表于 2024-2-27 07:28
感谢作者研究。昨天折腾了一天，也实现了自定义任意纸张尺寸。办法是直接用作者的函数生成pc3和pmp文件，读 ...

能否分享一下用lsp读写unix文件？曾卡在这里很久

mj0000

baitang36 发表于 2024-2-28 04:51
能否分享一下用lsp读写unix文件？曾卡在这里很久

也是别人的函数，具体是谁分享的也忘记了都是拿来主义

2. ;; 按行读文本文件到表 (快于 read-line 函数)
   
3. (defun VlDos_ReadFile (Fil / FilObj FilPth FilSys OpnFil All)
   
4.   (if (and (setq FilPth (findfile Fil)) (setq FilSys (vlax-create-object "Scripting.FileSystemObject")))
   
5.     (progn
   
6.       (setq FilObj (vlax-invoke FilSys 'GetFile FilPth)
   
7.             OpnFil (vlax-invoke FilObj 'OpenAsTextStream 1 0) ;只读模式
   
8.             All    (car (Cov-Str2List (vlax-invoke OpnFil 'readall) '("\r\n"))) ;字符串转表
   
9.       )
   
10.       (vlax-invoke OpnFil 'Close)
    
11.       (vlax-release-object OpnFil)
    
12.       (vlax-release-object FilObj)
    
13.       (vlax-release-object FilSys)
    
14.     )
    
15.   )
    
16.   All
    
17. )
    
18. ;; 将字符串或表写入文件 (快于 write-line 函数)
    
19. (defun VlDos_WriteFile (Fil TXT Mode / FilObj FilPth FilSys OpnFil Line)
    
20.   (if TXT
    
21.     (progn
    
22.       (if (and (member mode '("w" "W")) (findfile Fil))
    
23.         (vl-file-delete (findfile Fil)) ;为T时删除原文件
    
24.       )
    
25.       (if (setq FilSys (vlax-create-object "Scripting.FileSystemObject"))
    
26.         (progn
    
27.           (if (null (setq FilPth (findfile Fil)))
    
28.             (setq OpnFil (vlax-invoke FilSys 'CreateTextFile Fil 0 0)) ;文件编码为为ASCII格式（最后一个参数控制编码 0 = ascii编码, -1 = unicode编码, -2 system default编码）
    
29.             (setq FilObj (vlax-invoke FilSys 'GetFile FilPth)
    
30.                   OpnFil (vlax-invoke FilObj 'OpenAsTextStream 8 0) ;添加模式
    
31.             )
    
32.           )
    
33.           (if OpnFil
    
34.             (progn
    
35.               (vlax-invoke OpnFil 'Write (strcat (Cov-All_To_EleStr TXT "\r\n") "\r\n")) ;尾部加换行，不然添加模式下会有重叠的行
    
36.               (vlax-invoke OpnFil 'Close)
    
37.               (vlax-release-object OpnFil)
    
38.               (if (= (type FilObj) 'vla-object)
    
39.                 (vlax-release-object FilObj)
    
40.               )
    
41.               (vlax-release-object FilSys)
    
42.             )
    
43.           )
    
44.         )
    
45.       )
    
46.       (if (setq Filpth (findfile Fil))
    
47.         (setq FilPth (YX:Get-VlDos_FormatPath filpth))
    
48.       )
    
49.     )
    
50.   )
    
51.   filpth
    
52. )

;; 按行读文本文件到表 (快于 read-line 函数)<br /> (defun VlDos_ReadFile (Fil / FilObj FilPth FilSys OpnFil All)<br />   (if (and (setq FilPth (findfile Fil)) (setq FilSys (vlax-create-object "Scripting.FileSystemObject")))<br />     (progn<br />       (setq FilObj (vlax-invoke FilSys 'GetFile FilPth)<br />             OpnFil (vlax-invoke FilObj 'OpenAsTextStream 1 0) ;只读模式<br />             All    (car (Cov-Str2List (vlax-invoke OpnFil 'readall) '("\r\n"))) ;字符串转表<br />       )<br />       (vlax-invoke OpnFil 'Close)<br />       (vlax-release-object OpnFil)<br />       (vlax-release-object FilObj)<br />       (vlax-release-object FilSys)<br />     )<br />   )<br />   All<br /> )<br /> ;; 将字符串或表写入文件 (快于 write-line 函数)<br /> (defun VlDos_WriteFile (Fil TXT Mode / FilObj FilPth FilSys OpnFil Line)<br />   (if TXT<br />     (progn<br />       (if (and (member mode '("w" "W")) (findfile Fil))<br />         (vl-file-delete (findfile Fil)) ;为T时删除原文件<br />       )<br />       (if (setq FilSys (vlax-create-object "Scripting.FileSystemObject"))<br />         (progn<br />           (if (null (setq FilPth (findfile Fil)))<br />             (setq OpnFil (vlax-invoke FilSys 'CreateTextFile Fil 0 0)) ;文件编码为为ASCII格式（最后一个参数控制编码 0 = ascii编码, -1 = unicode编码, -2 system default编码）<br />             (setq FilObj (vlax-invoke FilSys 'GetFile FilPth)<br />                   OpnFil (vlax-invoke FilObj 'OpenAsTextStream 8 0) ;添加模式<br />             )<br />           )<br />           (if OpnFil<br />             (progn<br />               (vlax-invoke OpnFil 'Write (strcat (Cov-All_To_EleStr TXT "\r\n") "\r\n")) ;尾部加换行，不然添加模式下会有重叠的行<br />               (vlax-invoke OpnFil 'Close)<br />               (vlax-release-object OpnFil)<br />               (if (= (type FilObj) 'vla-object)<br />                 (vlax-release-object FilObj)<br />               )<br />               (vlax-release-object FilSys)<br />             )<br />           )<br />         )<br />       )<br />       (if (setq Filpth (findfile Fil))<br />         (setq FilPth (YX:Get-VlDos_FormatPath filpth))<br />       )<br />     )<br />   )<br />   filpth<br /> )

mj0000

补充两个子函数
Cov-Str2List by llsheng_73 -- http://bbs.mjtd.com/forum.php?mod=viewthread&tid=109842

2. ;; 任意值转字符串
   
3. (defun Cov-All_To_EleStr (Val Str)
   
4.   (if (not Str)
   
5.     (setq Str " ") ;默认分割字符
   
6.   )
   
7.   (cond
   
8.     ((= (type Val) 'INT) (vl-princ-to-string Val))
   
9.     ((= (type Val) 'REAL) (vl-princ-to-string Val))
   
10.     ((= (type Val) 'list) ;有子表时，递归
    
11.      (apply 'strcat
    
12.             (cons
    
13.               (Cov-All_To_EleStr (car Val) Str)
    
14.               (mapcar
    
15.                 '(lambda (l) (strcat Str (Cov-All_To_EleStr l Str)))
    
16.                 (cdr Val)
    
17.               )
    
18.             )
    
19.      )
    
20.     )
    
21.     ((= (type Val) 'STR) Val) ;参数是单独的一个字符串也可以，容错
    
22.     (t "")
    
23.   )
    
24. )

;; 任意值转字符串<br /> (defun Cov-All_To_EleStr (Val Str)<br />   (if (not Str)<br />     (setq Str " ") ;默认分割字符<br />   )<br />   (cond<br />     ((= (type Val) 'INT) (vl-princ-to-string Val))<br />     ((= (type Val) 'REAL) (vl-princ-to-string Val))<br />     ((= (type Val) 'list) ;有子表时，递归<br />      (apply 'strcat<br />             (cons<br />               (Cov-All_To_EleStr (car Val) Str)<br />               (mapcar<br />                 '(lambda (l) (strcat Str (Cov-All_To_EleStr l Str)))<br />                 (cdr Val)<br />               )<br />             )<br />      )<br />     )<br />     ((= (type Val) 'STR) Val) ;参数是单独的一个字符串也可以，容错<br />     (t "")<br />   )<br /> )

baitang36

mj0000 发表于 2024-2-28 10:05
也是别人的函数，具体是谁分享的也忘记了都是拿来主义

write-line会把0A自动变成0d 0a 这样unix格式就变成一般的文本格式了，导致pc3加载时崩溃
后来我用二进制写的，用保留函数实现，这也是导致不提供源码的原因。