lisp添加文件夹到"支持文件搜索路径"

ygrzz

;;; 设置路径===xyp1964
(defun c:test041 (/ a pa lst ls1 path)
    (setq a (getenv "ACAD")
          pa (getstring "\n盘符 : ")   ; 要增加的路径，由用户自己改写
          lst (list ":\block\a1" ":\block\a2" ":\block\a3" ":\bk\b1" ":\bk\b2" ":\bk\b3" ":\bk\pat" ;
              )
          ls1 (car lst)
          path (strcat ";" pa ls1)
          lst (vl-remove ls1 lst)
    )
    (while lst
        (setq ls1 (car lst)
              path (strcat path (strcat ";" pa ls1))
              lst (vl-remove ls1 lst)
        )
    )
    (setenv "ACAD" (strcat a path))
    (getenv "ACAD")
)
;;; yfy2003
;;; 添加文件夹到"支持文件搜索路径"中的指定位置
(defun addSupportPath (dir pos / tmp c)
    (setq tmp ""
          c -1
    )
    (if (not pos)
        (setq tmp (strcat (getenv "ACAD") ";" dir))
        (mapcar
            '(lambda (x)
                 (setq tmp (if (= (setq c (1+ c))
                                  pos
                               )
                               (strcat tmp ";" dir ";" x)
                               (strcat tmp ";" x)
                           )
                 )
             )
            (parse (getenv "ACAD") ";")
        )
    )
    (setenv "ACAD" tmp)
    (princ)
)
;| 调用示例  (addSupportPath "D:\\myFolder" 2)
参数文件夹路径及插入的位置( "ACAD"<--- 一定要大写)
注意:位置参数为空时将文件夹添加到路径最后。
位置参数为0时将文件夹添加到路径最前端。  |;
(defun Example_SupportPath ()          ; 这个范例返回
                                       ; SupportPath的当前设定值，接着改变它的值，最后恢复初始值
    (VL-LOAD-COM)
    (setq AcadObject (vlax-get-acad-object)
          AcadDocument (vla-get-ActiveDocument AcadObject)
          mSpace (vla-get-ModelSpace AcadDocument)
    )
    (setq preferenceSel (vla-get-Preferences AcadObject))
    (setq fileSel (vla-get-Files preferenceSel)) ; 取出当前的SupportPath值
    (setq currSupportPath (vla-get-SupportPath fileSel))
    (princ "SupportPath的值当前设定为: ")
    (princ currSupportPath)
    (princ "   SupportPath范例\\n")
    (PROMPT "<Enter>进行:")
    (VL-CMDF pause)                    ; 改变SupportPath的值
    (vla-put-SupportPath fileSel "TestSupportPath")
    (setq newSupportPath (vla-get-SupportPath fileSel))
    (princ "SupportPath的新值设定为: ")
    (princ newSupportPath)
    (princ "   SupportPath范例\\n")
    (PROMPT "<Enter>进行:")
    (VL-CMDF pause)                    ; 将 SupportPath 重设为原来的值
    (vla-put-SupportPath fileSel currSupportPath)
    (vla-Regen AcadDocument acAllViewports)
    (princ "SupportPath的值已经重设为: ")
    (princ currSupportPath)
    (princ "   SupportPath范例\\n")
    (princ)
)

hai20110730

另外补充一个错误，是“\\”不是“\”，不过还是非常谢谢你分享的源码。

daiguafan

这个代表不错，谢谢

hai20110730

我发现这几个程序中前2个都有错误，分号放错地方了，而且第一个那样写程序应该比较浪费，实际可以写的更省略一些的。

love_cq

非常好的帖子，学习了。

paulpipi

xiaojiajun160

萌新表示值得研究

wzt

; 添加文件夹到"支持文件搜索路径"中的指定位置   (parse (getenv "ACAD") ";") 不能执行 是什么原因

timmy521

好东西，谢谢

流动的清泉

没有 parse 子命令