拖进绘图区域自动加载至启动组

tryhi

在论坛一直搜索不到一个现成的加入启动组的函数，写了一个跟大家分享

2. (vl-Load-COM)
   
3. (defun try-tuo-path(/ path str)
   
4.   (princ "\n")
   
5.   (setq path (getvar "lastprompt"))
   
6.   (if (wcmatch (strcase path) "*(LOAD "*")
   
7.     (setq str (vl-string-search "(LOAD "" path)
   
8.       path (substr path (+ str 8) (- (vl-string-search "")" path) str 7))
   
9.     )
   
10.   )
    
11.   (vl-string-translate "/" "\" path)
    
12. )
    
13. (defun try-appload-startup (path / i k n new-n strart-path)
    
14.   (setq n
    
15.     (vl-registry-read
    
16.       (setq strart-path
    
17.         (strcat "HKEY_CURRENT_USER\"
    
18.           (vlax-product-key)
    
19.           "\\Profiles\"
    
20.           (getvar "CPROFILE")
    
21.           "\\Dialogs\\Appload\\Startup"
    
22.         ))
    
23.       "NumStartup"
    
24.     )
    
25.     i 0
    
26.     k T
    
27.   )
    
28.   (repeat (atoi n)
    
29.     (setq i(1+ i))
    
30.     (if(= path(vl-registry-read strart-path (strcat(itoa i)"Startup")))(setq k nil))
    
31.   )
    
32.   (if k
    
33.     (progn
    
34.       (vl-registry-write strart-path "NumStartup" (setq new-n(itoa (1+ (atoi n)))))
    
35.       (vl-registry-write strart-path (strcat new-n "Startup") path)
    
36.     )
    
37.   )
    
38. )
    
39. 
    
40. ;;;程序开始
    
41. (setq path(try-tuo-path))
    
42. (if (= ":"(substr path 2 1))(progn(try-appload-startup path)(prompt "\n成功加载至启动组"))(prompt "\n本程序只能通过拖动来加载"))
    
43. (prin1)

(vl-Load-COM)<br /> (defun try-tuo-path(/ path str)<br />   (princ "\n")<br />   (setq path (getvar "lastprompt"))<br />   (if (wcmatch (strcase path) "*(LOAD "*")<br />     (setq str (vl-string-search "(LOAD "" path)<br />       path (substr path (+ str 8) (- (vl-string-search "")" path) str 7))<br />     )<br />   )<br />   (vl-string-translate "/" "\" path)<br /> )<br /> (defun try-appload-startup (path / i k n new-n strart-path)<br />   (setq n<br />     (vl-registry-read<br />       (setq strart-path<br />         (strcat "HKEY_CURRENT_USER\"<br />           (vlax-product-key)<br />           "\\Profiles\"<br />           (getvar "CPROFILE")<br />           "\\Dialogs\\Appload\\Startup"<br />         ))<br />       "NumStartup"<br />     )<br />     i 0<br />     k T<br />   )<br />   (repeat (atoi n) <br />     (setq i(1+ i))<br />     (if(= path(vl-registry-read strart-path (strcat(itoa i)"Startup")))(setq k nil))<br />   )<br />   (if k <br />     (progn<br />       (vl-registry-write strart-path "NumStartup" (setq new-n(itoa (1+ (atoi n)))))<br />       (vl-registry-write strart-path (strcat new-n "Startup") path)<br />     )<br />   )<br /> )<br /> <br /> ;;;程序开始<br /> (setq path(try-tuo-path))<br /> (if (= ":"(substr path 2 1))(progn(try-appload-startup path)(prompt "\n成功加载至启动组"))(prompt "\n本程序只能通过拖动来加载"))<br /> (prin1)

注：附件的内容跟帖子里面的源码是一样的，不过多了几句无关紧要的注释，附件只是方便大家下载

自贡黄明儒

;;;xshrimp 2011.7

qazxswk

楼主的代码，我，加载不成功。我用下面的代码，加载成功

(vl-load-com)
(defun try-tuo-path(/ path str)
        (princ "\n")
        (setq path (getvar "lastprompt"));读取拖进黑框的路径
        (if (wcmatch (strcase path) "*(LOAD \"*")
                (setq str (vl-string-search "(LOAD \"" path)
                        path (substr path (+ str 8) (- (vl-string-search "\")" path) str 7))
                )
        )
        (vl-string-translate "/" "\\" path)
)
;(gps->appload-addfile "d:\\12.lsp")
(defun gps->appload-addfile (AppName /  $skey numstartup)
(if (= (type appname) 'STR)
(progn
  (setq  $skey (strcat "HKEY_CURRENT_USER\\"
                         (vlax-product-key)
                         "\\Profiles\\"
                         (getvar "CPROFILE")
                         "\\Dialogs\\Appload\\Startup")
  )
  (setq NumStartup (vl-registry-read $skey "NumStartup"))
  (if NumStartup
    (progn
    (vl-registry-write $skey (strcat (itoa (+ 1 (atoi NumStartup))) "Startup") AppName)
    (vl-registry-write $skey "NumStartup"(strcat (itoa (+ 1 (atoi NumStartup)))))
      )
    (progn
        (vl-registry-write $skey "0Startup" AppName)
    (vl-registry-write $skey "NumStartup" "1")
        )
  )
T
)
nil
)
)
(gps->appload-addfile (try-tuo-path))

yangchao2005090

773786668 发表于 2016-4-6 19:11
不知道是不是电脑的问题，昨天拖入黑屏，重启后启动组里一直没有拖入的文件。

我的也是，不清楚为什么

shh1980

都是高手啊，只有膜拜的份儿，感谢！

szx025

没明白啥意思，这个程序干啥用

伪书虫86

一定要顶一顶

lidaxiu

路过学习了

海盗曹

有用，收藏了先

gufeng

Win7 64位的可能吗？

tryhi

gufeng 发表于 2016-3-28 11:31
Win7 64位的可能吗？

64位应该是可以的

xyz002

有用