用秋枫老大的程序打包为何不能添加到搜索支持路径？

bikeboy

CAD为2014、2016版，用下文代码为何不能添加搜索支持路径？请各位老大指正啊.

2. 
   
3. 
   
4. (defun InitCttApplication (/
   
5.                            GetMyApplicationPath GetCttPath
   
6.                            strParse             StrUnParse
   
7.                            Ctt_AddSupportPath   Load_CttMenu
   
8.                            ctt_placemenu
   
9.                            Ctt_cmdecho_save
   
10.                           )
    
11. 
    
12.   (defun GetMyApplicationPath (AppID)
    
13.     (vl-registry-read
    
14.       (strcat
    
15.         "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\"
    
16.         AppID
    
17.         "_is1"
    
18.       )
    
19.       "Inno Setup: App Path"
    
20.     )
    
21.   )
    
22. 
    
23. 
    
24.   (defun GetCttPath ()
    
25.     (GetMyApplicationPath "SCAD")
    
26.   )
    
27. 
    
28. 
    
29.   (defun strParse (Str Delimiter / SearchStr StringLen return n char)
    
30.     (setq SearchStr Str)
    
31.     (setq StringLen (strlen SearchStr))
    
32.     (setq return '())
    
33.     (while (> StringLen 0)
    
34.       (setq n 1)
    
35.       (setq char (substr SearchStr 1 1))
    
36.       (while (and (/= char Delimiter) (/= char ""))
    
37.         (setq n (1+ n))
    
38.         (setq char (substr SearchStr n 1))
    
39.       ) ;_ end of while
    
40.       (setq return (cons (substr SearchStr 1 (1- n)) return))
    
41.       (setq SearchStr (substr SearchStr (1+ n) StringLen))
    
42.       (setq StringLen (strlen SearchStr))
    
43.     ) ;_ end of while
    
44.     (reverse return)
    
45.   ) ;_ end of defun
    
46. 
    
47. 
    
48.   (defun StrUnParse (Lst Delimiter / return)
    
49.     (setq return "")
    
50.     (foreach str Lst
    
51.       (setq return (strcat return Delimiter str))
    
52.     ) ;_ end of foreach
    
53.     (substr return 2)
    
54.   ) ;_ end of defun
    
55.       
    
56.   (defun Ctt_AddSupportPath (PathToAdd isFirst / supportlist)
    
57.     (if (not
    
58.           (vl-string-search
    
59.             (strcase (strcat pathToAdd ";"))
    
60.             (strcase (strcat (getenv "ACAD") ";"))
    
61.           )
    
62.         )                              
    
63.       (progn
    
64.         (setq supportlist (strparse (getenv "ACAD") ";"))
    
65.         (setq supportlist
    
66.                (vl-remove-if-not
    
67.                  'vl-file-directory-p
    
68.                  supportlist
    
69.                )
    
70.         )                           
    
71.         (if isFirst
    
72.           (setq supportlist (cons PathToAdd supportlist))
    
73.           (setq supportlist (append supportlist (list PathToAdd)))
    
74.         )
    
75.         (setenv "ACAD" (strUnParse supportlist ";"))
    
76.       )
    
77.     )
    
78.   )
    
79. 
    
80. 
    
81. (defun Load_CttMenu (/ acadver)
    
82.     (setq acadver (atof (getvar "acadver")))
    
83.     (cond
    
84.       ((and (>= acadver 15.0) (< acadver 16.0))
    
85.        (command "_menuload" "ST.mns")
    
86.       )
    
87.       ((and (>= acadver 16.0) (<= acadver 16.1))
    
88.        (command "_menuload" "ST04.mns")
    
89.       )
    
90.       ((>= acadver 16.2) (command "_menuload" "ST06.mns"))
    
91.     )
    
92.   )
    
93. 
    
94. 
    
95.   (defun ctt_placemenu (/ n)
    
96.     (if (menugroup "SHIPTools")
    
97.       (progn
    
98.         (setq n 1)
    
99.         (while (< n 24)
    
100.           (if (menucmd (strcat "P" (itoa n) ".1=?"))
     
101.             (setq n (+ n 1))
     
102.             (progn
     
103.               (if (> n 3)
     
104.                 (setq n (- n 2))
     
105.                 (setq n 3)
     
106.               )                         ;if
     
107. 
     
108.               ;; (menucmd (strcat "p" (itoa n) "=+STools.pop4"))
     
109.               ;; (menucmd (strcat "p" (itoa n) "=+STools.pop3"))
     
110.               ;; (menucmd (strcat "p" (itoa n) "=+STools.pop2"))
     
111.               (menucmd (strcat "p" (itoa n) "=+STools.pop1"))
     
112.               (setq n 25)
     
113.             )                           ;progn
     
114.           )                             ;if
     
115.         )                               ;while
     
116.       )                                 ;progn
     
117.     )                                   ;if
     
118.     (princ)
     
119.   )
     
120. 
     
121. ;;; -----------------------------------------------------
     
122. ;;; main：
     
123. ;;; -----------------------------------------------------
     
124.   (setq Ctt_cmdecho_save (getvar "cmdecho"))
     
125.   (setvar "cmdecho" 0)
     
126. 
     
127. 
     
128.   (Ctt_AddSupportPath (GetCttPath) nil)
     
129.   (Ctt_AddSupportPath (strcat (GetCttPath) "\\Program") nil)
     
130. 
     
131. 
     
132.   (if (not (menugroup "STools"))
     
133.     (Load_CttMenu)
     
134.   )
     
135. 
     
136.   (ctt_placemenu)
     
137. 
     
138.   (setvar "cmdecho" Ctt_cmdecho_save)
     
139.   (setq Ctt_cmdecho_save nil)
     
140. 
     
141.   (princ "\n……加载 SCAD工具箱 v1.0……\n")
     
142. 
     
143. ) ;_end of defun initCttApplication
     
144. 
     
145. (initCttApplication)
     
146. 
     
147. (load "SLayer.lsp")
     
148. (load "STools.lsp")
     
149. 
     
150. (princ)
     
151. 
     
152. ;;; -----------------------------------------------------
     
153. ;;; other：
     
154. ;;; -----------------------------------------------------
     

<br /> <br /> (defun InitCttApplication (/<br />                            GetMyApplicationPath GetCttPath<br />                            strParse             StrUnParse<br />                            Ctt_AddSupportPath   Load_CttMenu<br />                            ctt_placemenu<br />                            Ctt_cmdecho_save<br />                           )<br /> <br />   (defun GetMyApplicationPath (AppID)<br />     (vl-registry-read<br />       (strcat<br />         "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\"<br />         AppID<br />         "_is1"<br />       )<br />       "Inno Setup: App Path"<br />     )<br />   )<br /> <br /> <br />   (defun GetCttPath ()<br />     (GetMyApplicationPath "SCAD")<br />   )<br /> <br /> <br />   (defun strParse (Str Delimiter / SearchStr StringLen return n char)<br />     (setq SearchStr Str)<br />     (setq StringLen (strlen SearchStr))<br />     (setq return '())<br />     (while (> StringLen 0)<br />       (setq n 1)<br />       (setq char (substr SearchStr 1 1))<br />       (while (and (/= char Delimiter) (/= char ""))<br />         (setq n (1+ n))<br />         (setq char (substr SearchStr n 1))<br />       ) ;_ end of while<br />       (setq return (cons (substr SearchStr 1 (1- n)) return))<br />       (setq SearchStr (substr SearchStr (1+ n) StringLen))<br />       (setq StringLen (strlen SearchStr))<br />     ) ;_ end of while<br />     (reverse return)<br />   ) ;_ end of defun<br /> <br /> <br />   (defun StrUnParse (Lst Delimiter / return)<br />     (setq return "")<br />     (foreach str Lst<br />       (setq return (strcat return Delimiter str))<br />     ) ;_ end of foreach<br />     (substr return 2)<br />   ) ;_ end of defun<br />       <br />   (defun Ctt_AddSupportPath (PathToAdd isFirst / supportlist)<br />     (if (not<br />           (vl-string-search<br />             (strcase (strcat pathToAdd ";"))<br />             (strcase (strcat (getenv "ACAD") ";"))<br />           )<br />         )                              <br />       (progn<br />         (setq supportlist (strparse (getenv "ACAD") ";"))<br />         (setq supportlist<br />                (vl-remove-if-not<br />                  'vl-file-directory-p<br />                  supportlist<br />                )<br />         )                           <br />         (if isFirst<br />           (setq supportlist (cons PathToAdd supportlist))<br />           (setq supportlist (append supportlist (list PathToAdd)))<br />         )<br />         (setenv "ACAD" (strUnParse supportlist ";"))<br />       )<br />     )<br />   )<br /> <br /> <br /> (defun Load_CttMenu (/ acadver)<br />     (setq acadver (atof (getvar "acadver")))<br />     (cond<br />       ((and (>= acadver 15.0) (< acadver 16.0))<br />        (command "_menuload" "ST.mns")<br />       )<br />       ((and (>= acadver 16.0) (<= acadver 16.1))<br />        (command "_menuload" "ST04.mns")<br />       )<br />       ((>= acadver 16.2) (command "_menuload" "ST06.mns"))<br />     )<br />   )<br /> <br /> <br />   (defun ctt_placemenu (/ n)<br />     (if (menugroup "SHIPTools")<br />       (progn<br />         (setq n 1)<br />         (while (< n 24)<br />           (if (menucmd (strcat "P" (itoa n) ".1=?"))<br />             (setq n (+ n 1))<br />             (progn<br />               (if (> n 3)<br />                 (setq n (- n 2))<br />                 (setq n 3)<br />               )                         ;if<br /> <br />               ;; (menucmd (strcat "p" (itoa n) "=+STools.pop4"))<br />               ;; (menucmd (strcat "p" (itoa n) "=+STools.pop3"))<br />               ;; (menucmd (strcat "p" (itoa n) "=+STools.pop2"))<br />               (menucmd (strcat "p" (itoa n) "=+STools.pop1"))<br />               (setq n 25)<br />             )                           ;progn<br />           )                             ;if<br />         )                               ;while<br />       )                                 ;progn<br />     )                                   ;if<br />     (princ)<br />   )<br /> <br /> ;;; -----------------------------------------------------<br /> ;;; main：<br /> ;;; -----------------------------------------------------<br />   (setq Ctt_cmdecho_save (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br /> <br /> <br />   (Ctt_AddSupportPath (GetCttPath) nil)<br />   (Ctt_AddSupportPath (strcat (GetCttPath) "\\Program") nil)<br /> <br /> <br />   (if (not (menugroup "STools"))<br />     (Load_CttMenu)<br />   )<br /> <br />   (ctt_placemenu)<br /> <br />   (setvar "cmdecho" Ctt_cmdecho_save)<br />   (setq Ctt_cmdecho_save nil)<br /> <br />   (princ "\n……加载 SCAD<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a>箱 v1.0……\n")<br /> <br /> ) ;_end of defun initCttApplication<br /> <br /> (initCttApplication)<br /> <br /> (load "SLayer.lsp")<br /> (load "STools.lsp")<br /> <br /> (princ)<br /> <br /> ;;; -----------------------------------------------------<br /> ;;; other：<br /> ;;; -----------------------------------------------------<br />

jltx123456

你要去试着看懂代码, ......

bikeboy

jltx123456 发表于 2016-3-3 08:23
你要去试着看懂代码, ......

搞定了。。。。