打印样式添加路径问题

429014673

如何用程序为打印样式添加一个搜索路径(如D盘A文件夹),原来CAD默认的打印样式 路径不更改的前提下.

edata

2. ;;;在原来的打印样式基层上添加新的打印样式路径。
   
3. ;;;此方法将使得菜单->文件->打印样式管理器出错,提示无法找到路径.
   
4. ;;;选择文件夹对话框采用秋枫函数
   
5. ;;;cad2006cn测试通过
   
6. (defun c:tt(/ pspath old_path n_path bakps k)
   
7.   (vl-load-com)
   
8.   (initget "Y")
   
9.   (if (and (setq bakps(vl-registry-read "HKEY_CURRENT_USER\\PrinterStylePath"));恢复初始路径
   
10.            (= (if (setq k (getkword "\n是否恢复CAD打印样式表安装默认路径(Y):"))(strcase k)) "Y"))
    
11.     (progn
    
12.       (princ "\n开始恢复")
    
13.     (setenv "PrinterStyleSheetDir" bakps)
    
14.     (vl-registry-delete "HKEY_CURRENT_USER\\PrinterStylePath");删除备份注册表
    
15.     )
    
16.     (progn
    
17.       (alert"此方法将使得菜单->文件->打印样式管理器出错,提示无法找到路径.")
    
18.       (if(setq pspath(qf_getFolder "选择添加打印样式路径:"));秋枫文件夹对话框函数
    
19.   (progn   
    
20.     (setq old_path(getenv "PrinterStyleSheetDir"))
    
21.     (if (vl-registry-read "HKEY_CURRENT_USER\\PrinterStylePath")(princ)      
    
22.     (vl-registry-write "HKEY_CURRENT_USER\\PrinterStylePath" "" old_path));备份初始路径到注册表
    
23.     (setq n_path (strcat old_path ";" pspath))
    
24.     (setenv "PrinterStyleSheetDir" n_path)
    
25.     )
    
26.   (princ"\n未指定路径")
    
27.   )
    
28.       )
    
29.     )
    
30.   (princ "\n新的打印样式路径为:")
    
31.   (getenv "PrinterStyleSheetDir")
    
32.   )
    
33. 
    
34. ;; 本代码仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊
    
35. ;; 用途之适应性, 以及商业销售所隐含作出的保证, 在此一概予以否认.
    
36. ;; ==================================================================
    
37. ;; 作者：秋枫，参考了灯火的VBA程序
    
38. ;; 用法：(qf_getFolder msg)
    
39. ;; 例子：(qf_getFolder "选择文件夹:")
    
40. ;; 返回值：字符串，文件夹路径，如果点了cancel, 返回nil
    
41. 
    
42. (defun qf_getFolder (msg / WinShell shFolder path catchit)
    
43.   (vl-load-com)
    
44.   (setq winshell (vlax-create-object "Shell.Application"))
    
45.   (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
    
46.   (setq
    
47.     catchit (vl-catch-all-apply
    
48.               '(lambda ()
    
49.                  (setq shFolder (vlax-get-property shFolder 'self))
    
50.                  (setq path (vlax-get-property shFolder 'path))
    
51.                )
    
52.             )
    
53.   )
    
54.   (if (vl-catch-all-error-p catchit)
    
55.     nil
    
56.     path
    
57.   )
    
58. )
    

;;;在原来的打印样式基层上添加新的打印样式路径。<br /> ;;;此方法将使得菜单->文件->打印样式管理器出错,提示无法找到路径.<br /> ;;;选择文件夹对话框采用秋枫函数<br /> ;;;cad2006cn测试通过<br /> (defun c:tt(/ pspath old_path n_path bakps k)<br />   (vl-load-com)<br />   (initget "Y")<br />   (if (and (setq bakps(vl-registry-read "HKEY_CURRENT_USER\\PrinterStylePath"));恢复初始路径<br />            (= (if (setq k (getkword "\n是否恢复CAD打印样式表安装默认路径(Y):"))(strcase k)) "Y"))<br />     (progn<br />       (princ "\n开始恢复")<br />     (setenv "PrinterStyleSheetDir" bakps)<br />     (vl-registry-delete "HKEY_CURRENT_USER\\PrinterStylePath");删除备份注册表<br />     )<br />     (progn<br />       (alert"此方法将使得菜单->文件->打印样式管理器出错,提示无法找到路径.")<br />       (if(setq pspath(qf_getFolder "选择添加打印样式路径:"));秋枫文件夹对话框函数<br />   (progn    <br />     (setq old_path(getenv "PrinterStyleSheetDir"))<br />     (if (vl-registry-read "HKEY_CURRENT_USER\\PrinterStylePath")(princ)      <br />     (vl-registry-write "HKEY_CURRENT_USER\\PrinterStylePath" "" old_path));备份初始路径到注册表<br />     (setq n_path (strcat old_path ";" pspath))<br />     (setenv "PrinterStyleSheetDir" n_path)<br />     )<br />   (princ"\n未指定路径")<br />   )<br />       )<br />     )<br />   (princ "\n新的打印样式路径为:")<br />   (getenv "PrinterStyleSheetDir")<br />   )<br /> <br /> ;; 本代码仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊<br /> ;; 用途之适应性, 以及商业销售所隐含作出的保证, 在此一概予以否认.<br /> ;; ==================================================================<br /> ;; 作者：秋枫，参考了灯火的VBA程序<br /> ;; 用法：(qf_getFolder msg)<br /> ;; 例子：(qf_getFolder "选择文件夹:")<br /> ;; 返回值：字符串，文件夹路径，如果点了cancel, 返回nil<br /> <br /> (defun qf_getFolder (msg / WinShell shFolder path catchit)<br />   (vl-load-com)<br />   (setq winshell (vlax-create-object "Shell.Application"))<br />   (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))<br />   (setq<br />     catchit (vl-catch-all-apply<br />               '(lambda ()<br />                  (setq shFolder (vlax-get-property shFolder 'self))<br />                  (setq path (vlax-get-property shFolder 'path))<br />                )<br />             )<br />   )<br />   (if (vl-catch-all-error-p catchit)<br />     nil<br />     path<br />   )<br /> )<br />

edata

鱼与熊掌，不可兼得。

edata

cad2006通过测试。可以搜索到样式表，即为所求，但是通过菜单 文件->打印样式管理器,无法打开样式路径，因为路径非法。