[原创]：轻松写CAD“启动组”函数（公开源代码）

hqd9639 · 发表于 2004-4-1 16:53:47

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

源程序在5楼

这是一组写 CAD“启动组”的函数，只要把:(hqd_wrStartup str)
函数写入你自已的程序里，该程序在AUTOCAD下次启动时就能自动加载。
该API包含两个函数：

1. 读CAD“启动组”函数

函数名: hqd_readStartup
调用方法:该函数没有变量，可直接调用。
返回值：表否则为NIL。
Example:(hqd_readStartup)

2. 写CAD“启动组”函数

函数名: hqd_wrStartup
调用方法:(hqd_wrStartup str)
返回值：写入成功返回字符串，否则为NIL。
Example:(hqd_wrStartup (findfile "hqd_WrStartup.lsp"))

eachy · 发表于 2004-4-2 12:18:42

;;当前配置
(defun GetstartupKey ()
(strcat "HKEY_CURRENT_USER\"
(vlax-product-key)
"\\Profiles\"
(vlax-get-property
(vlax-get-property
(vlax-get-property (vlax-get-acad-object) 'Preferences)
'Profiles
)
'activeprofile
)
"\\Dialogs\\Appload\\Startup"
)
)
;;自动加载文件数量
(defun getStartNum (/ acProfile num)
(setq num (vl-registry-read
(getstartupkey)
"NumStartup"
)
)
num
)
;;获取加载文件列表
(defun GetStartup (/ n startgroup)
(if (not (zerop (setq n (read (getstartnum)))))
(progn
(repeat n
(setq startgroup
(cons (vl-registry-read
(getstartupkey)
(strcat (itoa n)
"Startup"
)
)
startgroup
)
)
(setq n (1- n))
)
)
)
startgroup
)
;;写自动加载
;; path 自动加载文件，包括全路径
;; 注意要用 \\ 代替 \
(defun PutStartup (path / n)
(setq n (getstartnum))
(vl-registry-write
(strcat (getstartupkey)
"\"
(strcat (itoa (1+ n))
"Startup"
)
)
path
)
(vl-registry-write
(strcat (getstartupkey)
"\\NumStartup"
)
(atoi (1+ n))
)
)

;;当前配置 
(defun GetstartupKey () 
  (strcat "HKEY_CURRENT_USER\" 
          (vlax-product-key) 
          "\\Profiles\" 
          (vlax-get-property 
            (vlax-get-property 
              (vlax-get-property (vlax-get-acad-object) 'Preferences) 
              'Profiles 
            ) 
            'activeprofile 
          ) 
          "\\Dialogs\\Appload\\Startup" 
  ) 
) 
;;自动加载文件数量 
(defun getStartNum (/ acProfile num) 
  (setq        num (vl-registry-read 
              (getstartupkey) 
              "NumStartup" 
            ) 
  ) 
  num 
) 
;;获取加载文件列表 
(defun GetStartup (/ n startgroup) 
  (if (not (zerop (setq n (read (getstartnum))))) 
    (progn 
      (repeat n 
        (setq startgroup 
               (cons (vl-registry-read 
                       (getstartupkey) 
                       (strcat (itoa n) 
                               "Startup" 
                       ) 
                     ) 
                     startgroup 
               ) 
        ) 
        (setq n (1- n)) 
      ) 
    ) 
  ) 
  startgroup 
) 
;;写自动加载 
;; path 自动加载文件，包括全路径 
;; 注意要用 \\ 代替 \ 
(defun PutStartup (path / n) 
  (setq n (getstartnum)) 
  (vl-registry-write 
    (strcat (getstartupkey) 
            "\" 
            (strcat (itoa (1+ n)) 
                    "Startup" 
            ) 
    ) 
    path 
  ) 
  (vl-registry-write 
    (strcat (getstartupkey) 
            "\\NumStartup" 
    ) 
    (atoi (1+ n)) 
  ) 
)

eachy · 发表于 2004-4-1 19:11:59

CAD的启动组有时比较健忘。

陌生人 · 发表于 2004-4-2 00:34:30

我不能正常下载，楼主能把程序贴出来么？

hqd9639 · 发表于 2004-4-2 15:09:14

既然大家感兴趣，就贴出源代码大家共同讨论并完善。多谢eachy斑主捧场。

好像CAD各版本“启动组”在注册表中的位置不尽相同.

[FONT=courier new]
;;;2004-4-1 By HQD9639
;;;Version 0.1 FOR CAD2002
(defun hqd_ReadStartup (/ Snum ldf Slst)
(setq Snum 1)
(setq Slst '())
(while (setq ldf (vl-registry-read (strcat "HKEY_CURRENT_USER\"
(vlax-product-key) "\\Profiles\"
(getvar "CPROFILE") "\\Dialogs\\Appload\\Startup"
)
(strcat (itoa Snum) "Startup")
)
)
(setq Slst (append Slst (list ldf)))
(setq Snum (1+ Snum))
)
(if Slst Slst nil)
)
;;;
(defun hqd_WrStartup (lsptf / check_lf Snum ldf)
(if (= (type lsptf) 'STR)
(progn
(if (findfile lsptf)
(progn
(setq check_lf T)
(setq Snum 1)
(while (setq ldf (vl-registry-read (strcat "HKEY_CURRENT_USER\"
(vlax-product-key) "\\Profiles\"
(getvar "CPROFILE") "\\Dialogs\\Appload\\Startup"
)
(strcat (itoa Snum) "Startup")
)
)
(if (equal ldf lsptf) (setq check_lf nil))
(setq Snum (1+ Snum))
)
(if check_lf
(progn
(vl-registry-write (strcat "HKEY_CURRENT_USER\"
(vlax-product-key) "\\Profiles\"
(getvar "CPROFILE") "\\Dialogs\\Appload\\Startup"
)
(strcat (itoa Snum) "Startup") lsptf
)
(vl-registry-write (strcat "HKEY_CURRENT_USER\"
(vlax-product-key) "\\Profiles\"
(getvar "CPROFILE") "\\Dialogs\\Appload\\Startup"
)
"NumStartup" (itoa Snum)
)
lsptf
)
nil
)
)
nil
)
)
nil
)
)
[/FONT]

[FONT=courier new] 
;;;2004-4-1 By HQD9639 
;;;Version 0.1 FOR CAD2002 
(defun hqd_ReadStartup (/ Snum ldf Slst) 
   (setq Snum 1) 
   (setq Slst '()) 
   (while (setq ldf (vl-registry-read (strcat "HKEY_CURRENT_USER\" 
                                    (vlax-product-key) "\\Profiles\" 
                                   (getvar "CPROFILE") "\\Dialogs\\Appload\\Startup" 
                            ) 
                            (strcat (itoa Snum) "Startup") 
                ) 
          ) 
          (setq Slst (append Slst (list ldf))) 
          (setq Snum (1+ Snum))   
  ) 
  (if Slst  Slst nil) 
) 
;;; 
(defun hqd_WrStartup (lsptf / check_lf Snum ldf) 
  (if (= (type lsptf) 'STR) 
     (progn 
        (if (findfile lsptf) 
            (progn   
               (setq check_lf T) 
               (setq Snum 1) 
               (while (setq ldf (vl-registry-read (strcat "HKEY_CURRENT_USER\" 
                                                      (vlax-product-key) "\\Profiles\" 
                                                      (getvar "CPROFILE") "\\Dialogs\\Appload\\Startup" 
                                                  ) 
                                                  (strcat (itoa Snum) "Startup") 
                                ) 
                     ) 
                     (if (equal ldf lsptf) (setq check_lf nil))    
                     (setq Snum (1+ Snum))       
               ) 
               (if check_lf 
                  (progn 
                      (vl-registry-write (strcat "HKEY_CURRENT_USER\" 
                                             (vlax-product-key) "\\Profiles\" 
                                             (getvar "CPROFILE") "\\Dialogs\\Appload\\Startup" 
                                         ) 
                                         (strcat (itoa Snum) "Startup") lsptf 
                      ) 
                      (vl-registry-write (strcat "HKEY_CURRENT_USER\" 
                                             (vlax-product-key) "\\Profiles\" 
                                             (getvar "CPROFILE") "\\Dialogs\\Appload\\Startup" 
                                         ) 
                                         "NumStartup" (itoa Snum) 
                     )   
                     lsptf      
                  )   
                  nil 
              ) 
           ) 
           nil 
         ) 
      ) 
      nil 
  )   
) 
  [/FONT]

eachy · 发表于 2004-4-2 15:22:02

最初由 hqd9639 发布
[B]既然大家感兴趣，就贴出源代码大家共同讨论并完善。多谢eachy斑主捧场。

好像CAD各版本“启动组”在注册表中的位置不尽相同.

[CODE]

;;;2004-4-1 By HQD9639
;;;Version 0.1 FOR CAD2... [/B]

我观察了2002 2004 2005 的键值（WinXP）是一样的，用98和2000的或许不同。

另：

加密的目的是为了促进论坛更好的交流，坚决不欢迎拿了就走，舍不得奉献的人。

PFD8667 · 发表于 2004-7-28 17:02:50

问个外行话,不知5楼楼主的代码怎么用?

lucker6 · 发表于 2004-7-28 17:20:55

请问隐藏内容是什么呀？

[隐藏内容]
你的积分要到 5 分才能浏览里面的内容！

jx2008 · 发表于 2006-11-28 02:33:11

5楼的代码是没有主程序的，在4楼有，4楼eachy给限制掉了，好苛刻！目的是为了大家交流，还藏起来了，积分怎么又这么多，到现在我还不止到怎么弄几分呢，可心个人之，绝大多数都没有积分的，怎么交流呢？

huxkv · 发表于 2006-11-28 09:54:10

最初由 jx2008 发布
[B]5楼的代码是没有主程序的，在4楼有，4楼eachy给限制掉了，好苛刻！目的是为了大家交流，还藏起来了，积分怎么又这么多，到现在我还不止到怎么弄几分呢，可心个人之，绝大多数都没有积分的，怎么交流呢？ [/B]

我觉得这网站太不厚道!!!
本来就为了交流学习用,
每人水平参差不齐,
还要东限制西限制!!!
严重抗议!!!

oyxx_1023 · 发表于 2006-11-28 18:19:32

另：

加密的目的是为了促进论坛更好的交流，坚决不欢迎拿了就走，舍不得奉献的人。

那要求也太高了吧，积分5，论坛能有这个积分的人恐怕不多呀，伙计。

szmax · 发表于 2006-12-3 21:29:56

楼上的不要说了，两个子函数就够用了。

gufengyin · 发表于 2006-12-12 08:00:17

提供函数已经算很好的了，有了思路，自己研究就可以了。谢谢，看了自己用 NET 写了一个。

如果启动项里原来没有文件，文件新添加到启动项，还得确保AutoCAD启动时加载Appload模块
AcadAppload LOADCTRLS

xbbcad · 发表于 2007-3-14 20:12:07

这个代码是示范性质的，在某些特殊情况下会出错。注册表的读写有一些细节问题要考虑，不是这么简单的。

carrot1983 · 发表于 2007-3-15 17:52:46

楼主的源代码很精彩。。。很感谢。。受教了。
第一个是-读CAD“启动组”函数，那么读取完了以后呢。能做什么？这个我知道一点点...
第二个是写CAD“启动组”函数，某个程序添加到启动组，没错吧。
我有一个问题:
最重要的是，加到启动组我觉得没必要用lisp来加进去吧！我手动加就可以了。
如果要用到lisp达到半自动化的话，那么还应该有一个函数，就是把启动组的某个程序拿掉删除，
这样子的话。。。。这个程序就价值就提升不少。。。。呵呵。。
学习。。。学习。。。VLisp的函数还没记住呢。。。呵呵

账号		自动登录	找回密码
密码			立即注册

[原创]：轻松写CAD“启动组”函数（公开源代码）

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

本帖被以下淘专辑推荐:

相关帖子

源代码

Re: 源代码

Re: Re: 源代码

浏览过的版块