[LISP程序]：请教秋风几个位:如何在lisp程序中增加搜索路径?

lsjjm

请教秋风几个位:如何在lisp程序中增加搜索路径?

LUCAS

参考!!!!

2. 
   
3. (defun C:SUPPORT_PATH (/            ACADOBJECT         ACADDOCUMENT
   
4.                        PREF            PREF_FILES         PATH
   
5.                        SUPPORTPATH
   
6.                       )
   
7.   (vl-load-com)
   
8.   (setq ACADOBJECT (vlax-get-acad-object))
   
9.   (setq ACADDOCUMENT (vla-get-activedocument ACADOBJECT))
   
10.   (setq PREF (vla-get-preferences ACADOBJECT))
    
11.   (setq PREF_FILES (vla-get-files PREF))
    
12.   (setq PATH (vla-get-supportpath PREF_FILES));;取得原尋找路徑
    
13.   (setq SUPPORTPATH (strcat PATH ";C:\\Program Files\\mdt6"));;增加尋找路徑
    
14.   (vla-put-supportpath PREF_FILES SUPPORTPATH)
    
15.   (princ)
    
16. )
    

<br /> (defun C:SUPPORT_PATH (/            ACADOBJECT         ACADDOCUMENT<br />                        PREF            PREF_FILES         PATH<br />                        SUPPORTPATH<br />                       )<br />   (vl-load-com)<br />   (setq ACADOBJECT (vlax-get-acad-object))<br />   (setq ACADDOCUMENT (vla-get-activedocument ACADOBJECT))<br />   (setq PREF (vla-get-preferences ACADOBJECT))<br />   (setq PREF_FILES (vla-get-files PREF))<br />   (setq PATH (vla-get-supportpath PREF_FILES));;取得原尋找路徑<br />   (setq SUPPORTPATH (strcat PATH ";C:\\Program Files\\mdt6"));;增加尋找路徑<br />   (vla-put-supportpath PREF_FILES SUPPORTPATH)<br />   (princ)<br /> )<br />

秋枫

我也是这种办法。

长清

最初由 LUCAS 发布
[B]参考!!!!

[code]
(defun C:SUPPORT_PATH (/            ACADOBJECT         ACADDOCUMENT
                       PREF            PREF_FILES         PATH
                       SUPPORTPATH
                      )
  (vl-load-com)
  (setq ACADOBJECT (vlax-get-acad-objec... [/B]

建议先检查是否具备该路径，如有，就加上，否则不用加，另外，如果把新路径作为参数来传递，就具有通用性了，代码如下：

(defun C:SUPPORT_PATH ( NEWPATH /          
ACADOBJECT         ACADDOCUMENT
PREF            PREF_FILES         PATH
SUPPORTPATH
                      )
  (vl-load-com)；R14中不要此行  
  (setq ACADOBJECT (vlax-get-acad-object))
  (setq ACADDOCUMENT (vla-get-activedocument ACADOBJECT))
  (setq PREF (vla-get-preferences ACADOBJECT))
  (setq PREF_FILES (vla-get-files PREF)) ；R14中不要此行
  (setq PATH (vla-get-supportpath PREF_FILES));;取得原尋找路徑
  (if (NOT (vl-string-search NEWPATH PATH))
     (setq SUPPORTPATH (strcat PATH ";" NEWPATH));;增加尋找路徑
  )
  (vla-put-supportpath PREF_FILES SUPPORTPATH)
  (princ)
)

zhangzg

我在试这个程序过程中，返回的path是nil
是vla-get-files命令处出问题了。在帮助里也未能找到这个命令。
怎么解决？请高手指点！

长清

最初由 zhangzg 发布
[B]我在试这个程序过程中，返回的path是nil
是vla-get-files命令处出问题了。在帮助里也未能找到这个命令。
怎么解决？请高手指点！ [/B]

vla-get-files 是一个ActiveX命令，原型为vlax-get。files 是对象的属性，
vla-get 是调用对象属性的通用方法，在LISP中，为了使用面向对象的编程特征，可以调用vla-get加上“属性”来取得对象的特定属性值，而vla-put加上“属性”则为修改对象的特定属性值。在VLISP的帮助文件里，有一段为“advanced topics（高级话题） ”，包含这方面的内容。

注意了，在R14中，以上程序需要作简单的修改。改法如下：

(defun SUPPORT_PATH ( NEWPATH /
ACADOBJECT ACADDOCUMENT
PREF PREF_FILES PATH
SUPPORTPATH
)
(setq ACADOBJECT (vlax-get-acad-object))
(setq ACADDOCUMENT (vla-get-activedocument ACADOBJECT))
(setq PREF (vla-get-preferences ACADOBJECT))
(setq PATH (vla-get-supportpath PREF));;取得原尋找路徑
(if (NOT (vl-string-search NEWPATH PATH))
(setq SUPPORTPATH (strcat PATH ";" NEWPATH));;增加尋找路徑
)
(vla-put-supportpath PREF SUPPORTPATH)
(princ)
)

举例：
(support_path "c:\\")

zhangzg

我逐句执行，当执行到
(setq PATH (vla-get-supportpath PREF));;取得原尋找路徑
提示错误： ActiveX 服务器返回错误: 未知名称: SupportPath
我的pref的数据是：#<VLA-OBJECT IAcadDatabasePreferences 01d08904>
请问该怎样解决！

明经通道

这段函数完全能在R14中运行，没有用到VL


(defun add_path ( dir / a b c)
  (if (and dir
           (setq c (getenv "ACAD"))               
      );and
      (progn
       ;prepare to look for 'dir' within the AutoCAD search path
       (setq a (strcase c)
             b (strcase dir)
       );setq
       (if (not (equal ";" (substr a 1 1)))
           (setq a (strcat ";" a));add a ";" in front of the string if not already present
       );if
       (if (not (equal ";" (substr a (strlen a) 1)))
           (setq a (strcat a ";")
                 c (strcat c ";");add a trailing ";" if not already present
           );setq
       );if
       (if (not (wcmatch a (strcat "*;" b ";*"))) ;is 'dir' already present in search path?
           (progn
            (setq c (strcat c dir));setq
            (setenv "ACAD" c)
           );progn
           (setq c nil)
       );if   
      );progn then
      (setq c nil)
  );if
  c
);defun add_path

长清

最初由 明经通道 发布
[B]这段函数完全能在R14中运行，没有用到VL


(defun add_path ( dir / a b c)
  (if (and dir
           (setq c (getenv "ACAD"))               
      );and
      (progn
       ;prepare to look for '... [/B]

高人！！！

lsjjm

如果事先知道文件所在路经,用(findfile)直接找就行了, 问题是事先不知道你要找的文件在哪里?!

网络水手

不错，
(defun add_path ( dir / a b c)
(if (and dir
(setq c (getenv "ACAD"))
);and
(progn
;prepare to look for 'dir' within the AutoCAD search path
(setq a (strcase c)
b (strcase dir)
);setq
(if (not (equal ";" (substr a 1 1)))
(setq a (strcat ";" a));add a ";" in front of the string if not already present
);if
(if (not (equal ";" (substr a (strlen a) 1)))
(setq a (strcat a ";")
c (strcat c ";");add a trailing ";" if not already present
);setq
);if
(if (not (wcmatch a (strcat "*;" b ";*"))) ;is 'dir' already present in search path?
(progn
(setq c (strcat c dir));setq
(setenv "ACAD" c)
);progn
(setq c nil)
);if
);progn then
(setq c nil)
);if
c
);defun add_path

我用的也是这个！

jx2008

网络水手是哪位？是不是认识的哪位水手阿？