添加默认搜索目录

jun353835273

搜索了一下论坛全好像是用系统变量添加的，今天发现有现成的vla函数，分享给大家，方便关键词搜索，方便使用。

2. (setq  addpath "c:\\test" )
   
3. (setq Preferences
   
4.        (vla-get-Files
   
5.          (vla-get-Preferences
   
6.            (vlax-get-Acad-Object)
   
7.          )
   
8.        )
   
9. )
   
10. (setq paths (vla-get-SupportPath Preferences)) ;获取搜索目录
    
11. (vla-put-SupportPath Preferences (strcat(strcat paths ";" addpath))) ;设定搜索目录           
    
12. 
    
13. 
    
14. 
    

(setq  addpath "c:\\test" )<br /> (setq Preferences<br />        (vla-get-Files<br />          (vla-get-Preferences<br />            (vlax-get-Acad-Object)<br />          )<br />        )<br /> )<br /> (setq paths (vla-get-SupportPath Preferences)) ;获取搜索目录<br /> (vla-put-SupportPath Preferences (strcat(strcat paths ";" addpath))) ;设定搜索目录           <br /> <br /> <br /> <br />

xvjiex

vla添加默认搜索目录。
感谢分享！

muwind

(vla-get-SupportPath Preferences)好像等于 (getenv "ACAD" ）

jun353835273

muwind 发表于 2020-7-13 22:29
(vla-get-SupportPath Preferences)好像等于 (getenv "ACAD" ）

是的，系统变量

G〆h

setenv 之类的命令，CAD不能实时反应出来，建议用Autolisp相关命令。楼主的语句少了个判断，比如已有该路径了，就不能再添加了。另外支持路径有先后关系，有冲突的文件时，优先级的控制等。

jun353835273

G〆h 发表于 2020-7-14 11:12
setenv 之类的命令，CAD不能实时反应出来，建议用Autolisp相关命令。楼主的语句少了个判断，比如已有该路径 ...

只是给出的一种方法，需要的自己添加吧，
不是贴的完整的函数，不过也没有写

jun353835273

居然翻到高飞鸟国外论坛发的
；http://www.theswamp.org/index.php?topic=38073.msg430932#msg430932

2. ;;; --------------------------------------------------------------------
   
3. ;;; Function: Add a path and its subdirectories to AutoCAD support path.
   
4. ;;; Highflybird  2011.4.25                                             
   
5. ;;; --------------------------------------------------------------------
   
6. 
   
7. (vl-load-com)
   
8. (prompt "The command is: Test")
   
9. (defun c:test(/ *Shell FSO Folder Path LastString LST OldSupportPath NewSupportPath)
   
10.   ;; Search All the Subdirectories
    
11.   (defun SearchPath (path / f n p Dirs)
    
12.     (setq Dirs (vl-directory-files path nil -1))
    
13.     (setq f (car Dirs))
    
14.     (and (= f ".") (setq Dirs (cddr Dirs)))
    
15.     (foreach n Dirs
    
16.       (setq p (strcat Path n "\"))
    
17.       (setq Lst (cons p Lst))
    
18.       (SearchPath p)
    
19.     )
    
20.     lst
    
21.   )
    
22. 
    
23.   (setq *Shell (vlax-create-object "Shell.Application"))                ;Create a Shell Object to select folder       
    
24.   (setq FSO (vlax-create-object "Scripting.FileSystemObject"))                ;Create a File system object to check the Folder.
    
25.   (setq Folder
    
26.     (vlax-invoke *Shell 'BrowseForFolder                                 ;Browse for folder
    
27.       (vla-get-hwnd (vlax-get-acad-object))
    
28.       "Select a Folder"
    
29.       83
    
30.     )
    
31.   )
    
32. 
    
33.   (if (and Folder
    
34.            (setq Path (vlax-get (vlax-get Folder 'self) 'path))
    
35.            (/= (vlax-invoke FSO 'FolderExists Path) 0)
    
36.       )
    
37.     (progn
    
38.       (setq LastString (substr path (strlen path)))
    
39.       (if (or (/= LastString "\") (/= LastString "/") )
    
40.         (setq Path (strcat Path "\"))
    
41.       )
    
42.       (setq Lst (list Path))
    
43.       (setq Lst (reverse (SearchPath Path)))
    
44.       (setq OldSupportPath (getenv "ACAD"))                                ;Get old support path
    
45.       ;;(setvar "USERS1" OldSupportPath)
    
46.       (setq NewSupportPath OldSupportPath)
    
47.       (foreach p Lst
    
48.         (setq NewSupportPath (strcat NewSupportPath ";" p))
    
49.       )
    
50.       (setenv "ACAD" NewSupportPath)                                        ;set new support path
    
51.     )
    
52.   )
    
53.   (and FSO (vlax-release-object FSO))
    
54.   (and *SHELL (vlax-release-object *SHELL))
    
55.   (princ)
    
56. )
    
57. 
    

;;; --------------------------------------------------------------------<br /> ;;; Function: Add a path and its subdirectories to AutoCAD support path.<br /> ;;; Highflybird  2011.4.25                                             <br /> ;;; --------------------------------------------------------------------<br /> <br /> (vl-load-com)<br /> (prompt "The command is: Test")<br /> (defun c:test(/ *Shell FSO Folder Path LastString LST OldSupportPath NewSupportPath)<br />   ;; Search All the Subdirectories<br />   (defun SearchPath (path / f n p Dirs)<br />     (setq Dirs (vl-directory-files path nil -1))<br />     (setq f (car Dirs))<br />     (and (= f ".") (setq Dirs (cddr Dirs)))<br />     (foreach n Dirs<br />       (setq p (strcat Path n "\"))<br />       (setq Lst (cons p Lst))<br />       (SearchPath p)<br />     )<br />     lst<br />   )<br /> <br />   (setq *Shell (vlax-create-object "Shell.Application"))                ;Create a Shell Object to select folder        <br />   (setq FSO (vlax-create-object "Scripting.FileSystemObject"))                ;Create a File system object to check the Folder.<br />   (setq Folder<br />     (vlax-invoke *Shell 'BrowseForFolder                                 ;Browse for folder<br />       (vla-get-hwnd (vlax-get-acad-object))<br />       "Select a Folder"<br />       83<br />     )<br />   )<br /> <br />   (if (and Folder<br />            (setq Path (vlax-get (vlax-get Folder 'self) 'path))<br />            (/= (vlax-invoke FSO 'FolderExists Path) 0)<br />       )<br />     (progn<br />       (setq LastString (substr path (strlen path)))<br />       (if (or (/= LastString "\") (/= LastString "/") )<br />         (setq Path (strcat Path "\"))<br />       )<br />       (setq Lst (list Path))<br />       (setq Lst (reverse (SearchPath Path)))<br />       (setq OldSupportPath (getenv "ACAD"))                                ;Get old support path<br />       ;;(setvar "USERS1" OldSupportPath)<br />       (setq NewSupportPath OldSupportPath)<br />       (foreach p Lst<br />         (setq NewSupportPath (strcat NewSupportPath ";" p))<br />       )<br />       (setenv "ACAD" NewSupportPath)                                        ;set new support path<br />     )<br />   )<br />   (and FSO (vlax-release-object FSO))<br />   (and *SHELL (vlax-release-object *SHELL))<br />   (princ)<br /> )<br /> <br />