[求助]：在明径上找的两个通用子程序，我试了半天也不成功啊，为什么啊

青马

加载子程序后，（addsupportpath "c:\\temp"）后就是没反应，在AutoCAD支持搜索路径中就是找不到我新加的，为什么啊，我用的是cad2004

2. 
   
3. ;;;AddSupportPath
   
4. ;;;添加文件夹到AutoCAD支持搜索路径中的指定位置
   
5. ;;;参数
   
6. ;;;文件夹路径及插入的位置(0时插入前端)
   
7. ;;;示例
   
8. ;;;(addSupportPath "c:\\myFolder" 2)
   
9. ;;;注意
   
10. ;;;位置参数为空时将文件夹添加到路径最后。位置参数为0时将文件夹添加到路径最前端。
    
11. (defun addSupportPath (dir pos / tmp c)
    
12.   (setq        tmp ""
    
13.         c   -1
    
14.   )
    
15.   (if (not pos)
    
16.     (setq tmp (strcat (getenv "ACAD") ";" dir))
    
17.     (mapcar '(lambda (x)
    
18.                (setq tmp (if (= (setq c (1+ c)) pos)
    
19.                            (strcat tmp ";" dir ";" x)
    
20.                            (strcat tmp ";" x)
    
21.                          )
    
22.                )
    
23.              )
    
24.             (parse (getenv "ACAD") ";")
    
25.     )
    
26.   )
    
27.   (setenv "ACAD" tmp)
    
28.   (princ)
    
29. )
    
30. 
    
31. 
    
32. 
    
33. ;;;removeSupportPath
    
34. ;;;从AutoCAD支持搜索路径中移去指定文件夹
    
35. ;;;参数
    
36. ;;;所要移去的文件夹
    
37. ;;;示例
    
38. ;;;(removeSupportPath "c:\myFolder")
    
39. (defun removeSupportPath (dir / tmp)
    
40.   (setq tmp "")
    
41.   (mapcar '(lambda (x)
    
42.              (if (/= (strcase x) (strcase dir))
    
43.                (setq tmp (strcat tmp x ";"))
    
44.              )
    
45.            )
    
46.           (parse (getenv "ACAD"))
    
47.   )
    
48.   (setenv "ACAD" (substr tmp 1 (1- (strlen tmp))))
    
49.   (princ)
    
50. )

<br /> ;;;AddSupportPath<br /> ;;;添加文件夹到AutoCAD支持搜索路径中的指定位置<br /> ;;;参数<br /> ;;;文件夹路径及插入的位置(0时插入前端)<br /> ;;;示例<br /> ;;;(addSupportPath "c:\\myFolder" 2) <br /> ;;;注意<br /> ;;;位置参数为空时将文件夹添加到路径最后。位置参数为0时将文件夹添加到路径最前端。<br /> (defun addSupportPath (dir pos / tmp c)<br />   (setq        tmp ""<br />         c   -1<br />   )<br />   (if (not pos)<br />     (setq tmp (strcat (getenv "ACAD") ";" dir))<br />     (mapcar '(lambda (x)<br />                (setq tmp (if (= (setq c (1+ c)) pos)<br />                            (strcat tmp ";" dir ";" x)<br />                            (strcat tmp ";" x)<br />                          )<br />                )<br />              )<br />             (parse (getenv "ACAD") ";")<br />     )<br />   )<br />   (setenv "ACAD" tmp)<br />   (princ)<br /> )<br /> <br /> <br /> <br /> ;;;removeSupportPath<br /> ;;;从AutoCAD支持搜索路径中移去指定文件夹<br /> ;;;参数<br /> ;;;所要移去的文件夹<br /> ;;;示例<br /> ;;;(removeSupportPath "c:\myFolder") <br /> (defun removeSupportPath (dir / tmp)<br />   (setq tmp "")<br />   (mapcar '(lambda (x)<br />              (if (/= (strcase x) (strcase dir))<br />                (setq tmp (strcat tmp x ";"))<br />              )<br />            )<br />           (parse (getenv "ACAD"))<br />   )<br />   (setenv "ACAD" (substr tmp 1 (1- (strlen tmp))))<br />   (princ)<br /> )

eachy

再找 Parse  子函数

它山之石

[php]
(defun Parse
       (Str Delimiter / SearchStr StringLen return n char)
  (setq SearchStr Str)
  (setq StringLen (strlen SearchStr))
  (setq return '())
  (while (> StringLen 0)
    (setq n 1)
    (setq char (substr SearchStr 1 1))
    (while (and (/= char Delimiter) (/= char ""))
      (setq n (1+ n))
      (setq char (substr SearchStr n 1))
    )
    (setq return (cons (substr SearchStr 1 (1- n)) return))
    (setq SearchStr (substr SearchStr (1+ n) StringLen))
    (setq StringLen (strlen SearchStr))
  )
  (reverse return)
)

[/php]

狂刀

2. 
   
3. ;;移除指定cad搜索路径.
   
4. ;;移除指定cad搜索路径.
   
5. (defun x@rempath (path)
   
6.   (setenv "ACAD" (vl-string-subst  "" (strcat (vl-string-right-trim ";" path) ";") (getenv "ACAD")))
   
7. )
   
8. )

<br /> ;;移除指定cad搜索路径.<br /> ;;移除指定cad搜索路径.<br /> (defun x@rempath (path)<br />   (setenv "ACAD" (vl-string-subst  "" (strcat (vl-string-right-trim ";" path) ";") (getenv "ACAD")))<br /> )<br /> )