（XD::AutoStartup）设置一个应用程序自动随ACAD启动

lw5297590 · 发表于 2018-5-5 10:55:03

学习一下，谢谢分享这么好的程序

xxxkkk331 · 发表于 2018-5-13 20:26:26

学习学习学习学习

Bao_lai · 发表于 2018-5-16 05:16:32

自己设置的有时候会失效

yjch · 发表于 2018-5-16 08:02:31

好好学习天天向上

wssczxf · 发表于 2018-5-16 08:37:08

回复，学习大师的程序

wdmzslw · 发表于 2018-5-22 15:10:23

看看marting老师的作品

ibingo · 发表于 2018-5-22 22:00:11

厉害了，学习一下

被承包的东子 · 发表于 2018-5-24 13:50:03

学习学习如何处理添加信任路径

李煜 · 发表于 2018-5-25 19:01:43

66666666666

hao3ren · 发表于 2018-5-30 11:27:54

回复，学习大师的程序

sicky111 · 发表于 2018-6-6 00:06:43

这个不错，学习一下。

柴月二号 · 发表于 2018-6-10 23:43:24

看看学学学

lwl450 · 发表于 2018-6-20 22:18:13

学习学习！！

bb建筑师 · 发表于 2018-6-24 01:49:34

原搜索路径不会判断原路径是否存在，删除此添加搜索路径与信任加载。
新增对路径已存在列表的判断。

找了很久，此代码是比较完善解决APPLOAD自动加载的问题。

(defun XD-AutoStartup (path tf / a allpro AppLoadPath NewNum no trpath verno x)
(if (setq path (findfile path))
(progn
(setq allpro (XD-Var-GetProfiles tf))
(mapcar
'(lambda (x)
(setq AppLoadPath
(strcat "HKEY_CURRENT_USER\"
(vlax-product-key) "\\Profiles\" x
"\\Dialogs\\Appload\\Startup"
)
)
(setq num (read (vl-registry-read AppLoadPath
"NumStartup"
)
)
n num
lst '()
)
(while (> n 0)
(setq lst (cons (vl-registry-read AppLoadPath (strcat (itoa n) "Startup")) lst) n (1- n))
)
(if (null (member path lst))
(progn
(setq NewNum (itoa (1+ num)))
(vl-registry-write AppLoadPath "NumStartup" NewNum)
(vl-registry-write AppLoadPath (strcat NewNum "Startup") path)
(princ (strcat "已增加自动加载路径：" path))
)
)
)
allpro
)
)
)
(princ)
)
(defun XD-Var-GetProfiles (tf)
(if tf
(progn (vla-getallprofilenames
(vla-get-profiles
(vla-get-preferences (vlax-get-acad-object))
)
'Profiles
)
(safearray-value Profiles)
)
(list (getvar "cprofile"))
)
)

(defun XD-AutoStartup (path tf / a allpro AppLoadPath NewNum no trpath verno x) 
  (if (setq path (findfile path)) 
    (progn 
      (setq allpro (XD-Var-GetProfiles tf)) 
      (mapcar 
        '(lambda (x) 
           (setq AppLoadPath 
                                                 (strcat "HKEY_CURRENT_USER\" 
                                                         (vlax-product-key) "\\Profiles\" x 
                                                         "\\Dialogs\\Appload\\Startup" 
                                                 ) 
           ) 
           (setq num (read (vl-registry-read AppLoadPath 
                                                                                                                 "NumStartup" 
                                                                                                         ) 
                                                                                 ) 
                                                 n num 
                                                 lst '() 
                                         ) 
                                         (while (> n 0) 
                                                 (setq lst (cons (vl-registry-read AppLoadPath (strcat (itoa n) "Startup")) lst) n (1- n))        
                                         ) 
                                         (if (null (member path lst)) 
                                                 (progn 
                                                         (setq NewNum (itoa (1+ num))) 
                                                         (vl-registry-write AppLoadPath "NumStartup" NewNum) 
                                                         (vl-registry-write AppLoadPath (strcat NewNum "Startup") path) 
                                                         (princ (strcat "已增加自动加载路径：" path)) 
                                                 ) 
                                         ) 
         ) 
        allpro 
      ) 
    ) 
  ) 
        (princ) 
) 
(defun XD-Var-GetProfiles (tf) 
  (if tf 
    (progn (vla-getallprofilenames 
             (vla-get-profiles 
               (vla-get-preferences (vlax-get-acad-object)) 
             ) 
             'Profiles 
           ) 
                        (safearray-value Profiles) 
    ) 
    (list (getvar "cprofile")) 
  ) 
)

wsklyq · 发表于 2018-6-24 21:20:37

厉害厉害厉害厉害厉害

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

[其他] （XD::AutoStartup）设置一个应用程序自动随ACAD启动