[LISP函数]：问个关于打印的问题，高手一定要过来看看。

userzhluserzhl

我有已设置好的“打印样式”acad.stb，我想把它复制到C:\Documents and Settings\“用户名”\Application Data\Autodesk\AutoCAD 2005\R16.1\chs\Plot Styles下，怎么用LSP实现？每台机的“用户名”又是不同的

秋枫

首先我建议你在标题中要写明确求助什么内容。这个标题太笼统了。

抽空给你做了一个比较完整的例子：

2. 
   
3. [FONT=courier new]
   
4. ([color=#800040]defun[/color] qf_FSO_CopyFile (src dest [color=#0000ff]/[/color] fso catchit)
   
5.   ([color=#0000ff]setq[/color]    catchit
   
6.      ([color=#0000ff]vl-catch-all-apply[/color]
   
7.        (function
   
8.          ([color=#800040]lambda[/color] ()
   
9.            ([color=#0000ff]setq[/color] fso
   
10.               ([color=#0000ff]vlax-create-object[/color] [color=#ff00ff]"Scripting.FileSystemObject"[/color])
    
11.            )
    
12.            ([color=#0000ff]if[/color] ([color=#0000ff]or[/color] ([color=#0000ff]not[/color] ([color=#0000ff]findfile[/color] dest)) ; 目标不存在
    
13.                ([color=#0000ff]and[/color]
    
14.              ([color=#0000ff]findfile[/color] dest) ; 目标文存在但比较旧
    
15.              (> ([color=#0000ff]vlax-get-property[/color]
    
16.                   ([color=#0000ff]vlax-invoke-method[/color]
    
17.                 fso
    
18.                 'getfile
    
19.                 ([color=#0000ff]findfile[/color] src)
    
20.                   )
    
21.                   'datelastmodified
    
22.                 )
    
23.                 ([color=#0000ff]vlax-get-property[/color]
    
24.                   ([color=#0000ff]vlax-invoke-method[/color]
    
25.                 fso
    
26.                 'getfile
    
27.                 ([color=#0000ff]findfile[/color] dest)
    
28.                   )
    
29.                   'datelastmodified
    
30.                 )
    
31.              )
    
32.                )
    
33.            )
    
34.          ([color=#0000ff]progn[/color]
    
35.            ([color=#0000ff]if[/color] ([color=#0000ff]findfile[/color] dest)
    
36.              ([color=#0000ff]vl-file-delete[/color] dest)
    
37.            )
    
38.            ([color=#0000ff]vlax-invoke-method[/color] fso 'copyfile ([color=#0000ff]findfile[/color] src) dest -1)
    
39.            ([color=#0000ff]princ[/color] [color=#ff00ff]"\n"[/color])
    
40.            ([color=#0000ff]princ[/color] ([color=#0000ff]findfile[/color] dest))
    
41.            ([color=#0000ff]princ[/color] [color=#ff00ff]"已更新."[/color])
    
42.          )
    
43.            )
    
44.            ([color=#0000ff]vlax-release-object[/color] fso)
    
45.          )                ;end of [color=#800040]lambda[/color]
    
46.        )                ;end of function
    
47.        nil
    
48.      )
    
49.   )
    
50.   ([color=#0000ff]if[/color] ([color=#0000ff]vl-catch-all-error-p[/color] catchit)
    
51.     nil
    
52.     'T
    
53.   )
    
54. )
    
55. ([color=#800040]defun[/color] copyfile (src dest)
    
56.   ([color=#0000ff]if[/color] ([color=#0000ff]null[/color] ( qf_FSO_CopyFile src dest))
    
57. [color=#008000]    ;; 如果采用FSO复制文件失败的话可以在这里定义其它复制方式[/color]
    
58. [color=#008000]    ;; (vl_copyfile src dest) [/color]
    
59.     nil
    
60.   )
    
61. )
    
62. ([color=#800040]defun[/color] installpstyles (src [color=#0000ff]/[/color] acadver dest)
    
63.   ([color=#0000ff]setq[/color] acadver ([color=#0000ff]atof[/color] ([color=#0000ff]getvar[/color] [color=#ff00ff]"acadver"[/color])))
    
64.   ([color=#0000ff]if[/color] ([color=#0000ff]and[/color] (>= acadver 15.0) (< acadver 16.0))
    
65. [color=#008000]                    ; AutoCAD 2000/2000i/2002[/color]
    
66.     ([color=#0000ff]setq[/color] dest ([color=#0000ff]strcat[/color] ([color=#0000ff]vl-filename-directory[/color] ([color=#0000ff]findfile[/color] [color=#ff00ff]"acad.exe"[/color]))
    
67.                "\\Plot Styles\"
    
68.                src
    
69.            )
    
70.     )
    
71. [color=#008000]                        ; else AutoCAD 2004+[/color]
    
72.     ([color=#0000ff]setq[/color] dest ([color=#0000ff]strcat[/color] ([color=#0000ff]getvar[/color] [color=#ff00ff]"ROAMABLEROOTPREFIX"[/color])
    
73.                "Plot Styles\"
    
74.                src
    
75.            )
    
76.     )
    
77.   )
    
78.   ( copyfile src dest)
    
79. )
    
80. 
    
81. [color=#008000];; 正式安装这些STB[/color]
    
82. ([color=#0000ff]mapcar[/color]    ' installpstyles
    
83.     '([color=#ff00ff]"acad.stb"[/color] [color=#ff00ff]"mystb.stb"[/color] [color=#ff00ff]"CTB2STB.stb"[/color]
    
84.      )
    
85. )
    
86. [/FONT]

<br /> [FONT=courier new]<br /> ([color=#800040]defun[/color] qf_FSO_CopyFile (src dest [color=#0000ff]/[/color] fso catchit)<br />   ([color=#0000ff]setq[/color]    catchit<br />      ([color=#0000ff]vl-catch-all-apply[/color]<br />        (function<br />          ([color=#800040]lambda[/color] ()<br />            ([color=#0000ff]setq[/color] fso<br />               ([color=#0000ff]vlax-create-object[/color] [color=#ff00ff]"Scripting.FileSystemObject"[/color])<br />            )<br />            ([color=#0000ff]if[/color] ([color=#0000ff]or[/color] ([color=#0000ff]not[/color] ([color=#0000ff]findfile[/color] dest)) ; 目标不存在<br />                ([color=#0000ff]and[/color]<br />              ([color=#0000ff]findfile[/color] dest) ; 目标文存在但比较旧<br />              (> ([color=#0000ff]vlax-get-property[/color]<br />                   ([color=#0000ff]vlax-invoke-method[/color]<br />                 fso<br />                 'getfile<br />                 ([color=#0000ff]findfile[/color] src)<br />                   )<br />                   'datelastmodified<br />                 )<br />                 ([color=#0000ff]vlax-get-property[/color]<br />                   ([color=#0000ff]vlax-invoke-method[/color]<br />                 fso<br />                 'getfile<br />                 ([color=#0000ff]findfile[/color] dest)<br />                   )<br />                   'datelastmodified<br />                 )<br />              )<br />                )<br />            )<br />          ([color=#0000ff]progn[/color]<br />            ([color=#0000ff]if[/color] ([color=#0000ff]findfile[/color] dest)<br />              ([color=#0000ff]vl-file-delete[/color] dest)<br />            )<br />            ([color=#0000ff]vlax-invoke-method[/color] fso 'copyfile ([color=#0000ff]findfile[/color] src) dest -1)<br />            ([color=#0000ff]princ[/color] [color=#ff00ff]"\n"[/color])<br />            ([color=#0000ff]princ[/color] ([color=#0000ff]findfile[/color] dest))<br />            ([color=#0000ff]princ[/color] [color=#ff00ff]"已更新."[/color])<br />          )<br />            )<br />            ([color=#0000ff]vlax-release-object[/color] fso)<br />          )                ;end of [color=#800040]lambda[/color]<br />        )                ;end of function <br />        nil<br />      )<br />   )<br />   ([color=#0000ff]if[/color] ([color=#0000ff]vl-catch-all-error-p[/color] catchit)<br />     nil<br />     'T<br />   )<br /> )<br /> ([color=#800040]defun[/color] copyfile (src dest)<br />   ([color=#0000ff]if[/color] ([color=#0000ff]null[/color] ( qf_FSO_CopyFile src dest))<br /> [color=#008000]    ;; 如果采用FSO复制文件失败的话可以在这里定义其它复制方式[/color]<br /> [color=#008000]    ;; (vl_copyfile src dest) [/color]<br />     nil<br />   )<br /> )<br /> ([color=#800040]defun[/color] installpstyles (src [color=#0000ff]/[/color] acadver dest)<br />   ([color=#0000ff]setq[/color] acadver ([color=#0000ff]atof[/color] ([color=#0000ff]getvar[/color] [color=#ff00ff]"acadver"[/color])))<br />   ([color=#0000ff]if[/color] ([color=#0000ff]and[/color] (>= acadver 15.0) (< acadver 16.0))<br /> [color=#008000]                    ; AutoCAD 2000/2000i/2002[/color]<br />     ([color=#0000ff]setq[/color] dest ([color=#0000ff]strcat[/color] ([color=#0000ff]vl-filename-directory[/color] ([color=#0000ff]findfile[/color] [color=#ff00ff]"acad.exe"[/color]))<br />                "\\Plot Styles\"<br />                src<br />            )<br />     )<br /> [color=#008000]                        ; else AutoCAD 2004+[/color]<br />     ([color=#0000ff]setq[/color] dest ([color=#0000ff]strcat[/color] ([color=#0000ff]getvar[/color] [color=#ff00ff]"ROAMABLEROOTPREFIX"[/color])<br />                "Plot Styles\"<br />                src<br />            )<br />     )<br />   )<br />   ( copyfile src dest)<br /> )<br /> <br /> [color=#008000];; 正式安装这些STB[/color]<br /> ([color=#0000ff]mapcar[/color]    ' installpstyles<br />     '([color=#ff00ff]"acad.stb"[/color] [color=#ff00ff]"mystb.stb"[/color] [color=#ff00ff]"CTB2STB.stb"[/color]<br />      )<br /> )<br /> [/FONT]

秋枫

简述一下思路。

我先试用过vl自带的文件复制函数。发现它对文件修改日期设置不对头。所以另外写了一个文件复制函数。注意：当你的Windows的FSO系统被强制手动封闭时这个函数也有可能失败的，一般情况下这个方式没有问题，除非你改动了Windows的这些基本服务。你也可以考虑其它方式复制，比如用shell调用系统的copy命令之类。我就不尝试了。

思路是这样的：比较系统中的文件与我的Src文件。在我的文件比较新的或系统中不存在我的文件的情况下才执行复制。我想你是要用它来安装stb。这样可以保证只有你的新stb改过之后才执行安装动作（copy）。不会导致每次启动AutoCAD加载这个lsp时都执行复制。

Plot Style的位置不同的autoCAD版本不一样。你看一下程序中就明白。
AutoCAD 2004 以上的版本可以通过(getvar "ROAMABLEROOTPREFIX")来做到你的顶楼的要求。

btw,
在你的LISP程序第一行加一句这个:
(vl-load-com)

ljpnb

何必这么麻烦呢，复制粘贴一下就可以了

怎么回事啊，附件显示不出来[/COLOR]

userzhluserzhl

秋枫，你2楼的程序要怎么执行？我的是2005可以吗？

四季豆

可以。

这是LISP程序啊。你为什么不试一下呢？

使用这个安装程序还是需要了解一些基本的LISP……二楼用的都是基本的LISP调用。你应该看得懂

二楼的代码可以看到从AutoCAD 2000至2004+ (2004/5/6)情况都考虑了。注释中写得很清楚。

userzhluserzhl

那如果我要把我的“样板文件”acad.dwt复制到
C:\Documents and Settings\“用户名”\Local Settings\Application Data\Autodesk\AutoCAD 2005\R16.1\chs\Template呢？