添加默认搜索目录
本帖最后由 jun353835273 于 2020-7-13 20:02 编辑搜索了一下论坛全好像是用系统变量添加的，今天发现有现成的vla函数，分享给大家，方便关键词搜索，方便使用。(setqaddpath "c:\\test" )
(setq Preferences
(vla-get-Files
(vla-get-Preferences
(vlax-get-Acad-Object)
)
)
)
(setq paths (vla-get-SupportPath Preferences)) ;获取搜索目录
(vla-put-SupportPath Preferences (strcat(strcat paths ";" addpath))) ;设定搜索目录
vla添加默认搜索目录。
感谢分享！ (vla-get-SupportPath Preferences)好像等于 (getenv "ACAD" ） muwind 发表于 2020-7-13 22:29
(vla-get-SupportPath Preferences)好像等于 (getenv "ACAD" ）
是的，系统变量 setenv 之类的命令，CAD不能实时反应出来，建议用Autolisp相关命令。楼主的语句少了个判断，比如已有该路径了，就不能再添加了。另外支持路径有先后关系，有冲突的文件时，优先级的控制等。 G〆h 发表于 2020-7-14 11:12
setenv 之类的命令，CAD不能实时反应出来，建议用Autolisp相关命令。楼主的语句少了个判断，比如已有该路径 ...
只是给出的一种方法，需要的自己添加吧，
不是贴的完整的函数，不过也没有写{:1_1:} 居然翻到高飞鸟国外论坛发的
；http://www.theswamp.org/index.php?topic=38073.msg430932#msg430932
;;; --------------------------------------------------------------------
;;; Function: Add a path and its subdirectories to AutoCAD support path.
;;; Highflybird2011.4.25
;;; --------------------------------------------------------------------
(vl-load-com)
(prompt "The command is: Test")
(defun c:test(/ *Shell FSO Folder Path LastString LST OldSupportPath NewSupportPath)
;; Search All the Subdirectories
(defun SearchPath (path / f n p Dirs)
(setq Dirs (vl-directory-files path nil -1))
(setq f (car Dirs))
(and (= f ".") (setq Dirs (cddr Dirs)))
(foreach n Dirs
(setq p (strcat Path n "\\"))
(setq Lst (cons p Lst))
(SearchPath p)
)
lst
)
(setq *Shell (vlax-create-object "Shell.Application")) ;Create a Shell Object to select folder
(setq FSO (vlax-create-object "Scripting.FileSystemObject")) ;Create a File system object to check the Folder.
(setq Folder
(vlax-invoke *Shell 'BrowseForFolder ;Browse for folder
(vla-get-hwnd (vlax-get-acad-object))
"Select a Folder"
83
)
)
(if (and Folder
(setq Path (vlax-get (vlax-get Folder 'self) 'path))
(/= (vlax-invoke FSO 'FolderExists Path) 0)
)
(progn
(setq LastString (substr path (strlen path)))
(if (or (/= LastString "\\") (/= LastString "/") )
(setq Path (strcat Path "\\"))
)
(setq Lst (list Path))
(setq Lst (reverse (SearchPath Path)))
(setq OldSupportPath (getenv "ACAD")) ;Get old support path
;;(setvar "USERS1" OldSupportPath)
(setq NewSupportPath OldSupportPath)
(foreach p Lst
(setq NewSupportPath (strcat NewSupportPath ";" p))
)
(setenv "ACAD" NewSupportPath) ;set new support path
)
)
(and FSO (vlax-release-object FSO))
(and *SHELL (vlax-release-object *SHELL))
(princ)
)
页:
[1]