写启动组

st788796 · 发表于 2013-7-9 17:41:26

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

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

×

[ 本帖最后由 st788796 于 2013-7-10 08:33 编辑 ]\n\n

(defun XD::AutoStartup (path tf / Profiles allpro newnum AutoLoadpath)
(vl-load-com)
(if tf
(progn
(vla-getallprofilenames
(vla-get-profiles
(vla-get-preferences (vlax-get-acad-object))
)
'Profiles
)
(setq allpro (safearray-value Profiles))
)
(setq allpro (list (getvar "cprofile")))
)
(setenv "ACAD"
(strcat (getenv "ACAD") ";" (vl-filename-directory path))
)
(if (wcmatch (getvar "acadver") "19.[1-9]*")
(if tf
(mapcar '(lambda (x / trpath)
(setq trpath (strcat
"HKEY_CURRENT_USER\\"
(vlax-product-key)
"\\Profiles\\"
x
"\\Variables"
)
)
(vl-registry-write
trpath
"Trustedpaths"
(strcat (vl-registry-read trpath "Trustedpaths")
";"
(vl-filename-directory path)
"\\..."
)
)
)
allpro
)
(setvar "TRUSTEDPATHS"
(strcat (getvar "TRUSTEDPATHS")
";"
(vl-filename-directory path)
"\\..."
)
)
)
)
(mapcar '(lambda (x)
(setq AppLoadPath
(strcat
"HKEY_CURRENT_USER\\"
(vlax-product-key)
"\\Profiles\\"
x
"\\Dialogs\\Appload\\Startup"
)
)
(setq
NewNum
(itoa
(1+ (read
(vl-registry-read AppLoadPath "NumStartup")
)
)
)
)
(vl-registry-write AppLoadPath "NumStartup" NewNum)
(vl-registry-write
AppLoadPath
(strcat NewNum "Startup")
path
)
)
allpro
)
(princ)
)

(defun XD::AutoStartup (path tf / Profiles allpro newnum AutoLoadpath) 
  (vl-load-com) 
  (if tf 
    (progn 
      (vla-getallprofilenames 
 (vla-get-profiles 
   (vla-get-preferences (vlax-get-acad-object)) 
 ) 
 'Profiles 
      ) 
      (setq allpro (safearray-value Profiles)) 
    ) 
    (setq allpro (list (getvar "cprofile"))) 
  ) 
  (setenv "ACAD" 
   (strcat (getenv "ACAD") ";" (vl-filename-directory path)) 
  ) 
  (if (wcmatch (getvar "acadver") "19.[1-9]*") 
    (if tf 
      (mapcar '(lambda (x / trpath) 
   (setq trpath (strcat 
    "HKEY_CURRENT_USER\\" 
    (vlax-product-key) 
    "\\Profiles\\" 
    x 
    "\\Variables" 
         ) 
   ) 
   (vl-registry-write 
     trpath 
     "Trustedpaths" 
     (strcat (vl-registry-read trpath "Trustedpaths") 
      ";" 
      (vl-filename-directory path) 
      "\\..." 
     ) 
   ) 
        ) 
       allpro 
      ) 
      (setvar "TRUSTEDPATHS" 
       (strcat (getvar "TRUSTEDPATHS") 
        ";" 
        (vl-filename-directory path) 
        "\\..." 
       ) 
      ) 
    ) 
  ) 
  (mapcar '(lambda (x) 
      (setq AppLoadPath 
      (strcat 
        "HKEY_CURRENT_USER\\" 
        (vlax-product-key) 
        "\\Profiles\\" 
        x 
        "\\Dialogs\\Appload\\Startup" 
      ) 
      ) 
      (setq 
        NewNum 
  (itoa 
    (1+ (read 
   (vl-registry-read AppLoadPath "NumStartup") 
        ) 
    ) 
  ) 
      ) 
      (vl-registry-write AppLoadPath "NumStartup" NewNum) 
      (vl-registry-write 
        AppLoadPath 
        (strcat NewNum "Startup") 
        path 
      ) 
    ) 
   allpro 
  ) 
  (princ) 
)

xshrimp · 发表于 2013-7-9 19:14:15

我看程序中很大一段是为了获取product-key,而且.楼主设定的是中文版的.
可以直接获取.
命令: (vlax-product-key)
"Software\\Autodesk\\AutoCAD\\R19.0\\ACAD-B001:804"

Lispboy · 发表于 2013-7-9 19:24:19

2008：

命令: (vlax-product-key)
"Software\\Autodesk\\AutoCAD\\R17.1\\ACAD-6001:804"

Lispboy · 发表于 2013-7-9 19:40:56

建议用正则表达式，这样写，试试：

命令: (car (XD::String:RegExpS "[^/\\\\]+$" (vlax-product-key) nil))
"ACAD-6001:804"

牢固 · 发表于 2013-7-9 20:37:01

本帖最后由牢固于 2013-7-9 20:44 编辑

Lispboy 发表于 2013-7-9 19:40
建议用正则表达式，这样写，试试：

命令: (car (XD::String:RegExpS "[^/\\\\]+$" (vlax-product-key) n ...

用不上正则吧！(vlax-product-key)得到的路径直接放后面jiu可以了！

(defun XD::AutoStartup (path tf / cadver cprofile item newnum path prefix regpath
str strload allpro Profiles
)
(vl-load-com)
(if tf
(progn
(vla-getallprofilenames
(vla-get-profiles
(vla-get-preferences (vlax-get-acad-object))
)
'Profiles
)
(setq allpro (safearray-value Profiles))
)
(setq allpro (list (getvar "cprofile")))
)
(setq prefix (getvar "Acadprefix"))
(setenv "ACAD"
(strcat (getenv "ACAD") ";" (vl-filename-directory path))
)
(mapcar '(lambda (x)
(setq AppLoadPath
(strcat
"HKEY_CURRENT_USER\\"
(vlax-product-key)
"\\Profiles\\"
x
"\\Dialogs\\Appload\\Startup"
)
)
(setq
NewNum
(itoa
(1+ (read
(vl-registry-read AppLoadPath "NumStartup")
)
)
)
)
(vl-registry-write AppLoadPath "NumStartup" NewNum)
(vl-registry-write
AppLoadPath
(strcat NewNum "Startup")
path
)
)
allpro
)
(princ)
)

(defun XD::AutoStartup (path  tf   /    cadver   cprofile   item  newnum   path    prefix   regpath 
   str  strload  allpro   Profiles 
         ) 
  (vl-load-com) 
  (if tf 
    (progn 
 
     (vla-getallprofilenames 
       (vla-get-profiles 
         (vla-get-preferences (vlax-get-acad-object)) 
       ) 
       'Profiles 
     ) 
     (setq allpro (safearray-value Profiles)) 
    ) 
    (setq allpro (list (getvar "cprofile"))) 
  ) 
  (setq prefix (getvar "Acadprefix")) 
  (setenv "ACAD" 
   (strcat (getenv "ACAD") ";" (vl-filename-directory path)) 
  ) 
  (mapcar '(lambda (x) 
      (setq AppLoadPath 
      (strcat 
        "HKEY_CURRENT_USER\\" 
        (vlax-product-key) 
        "\\Profiles\\" 
        x 
        "\\Dialogs\\Appload\\Startup" 
       ) 
      ) 
      (setq 
        NewNum 
  (itoa 
    (1+ (read 
   (vl-registry-read AppLoadPath "NumStartup") 
        ) 
    ) 
  ) 
      ) 
      (vl-registry-write AppLoadPath "NumStartup" NewNum) 
      (vl-registry-write 
        AppLoadPath 
        (strcat NewNum "Startup") 
        path 
      ) 
    ) 
   allpro 
  ) 
  (princ) 
)

Free-Lancer · 发表于 2013-7-9 20:39:45

可以简化简化的来自: Android客户端

牢固 · 发表于 2013-7-9 20:46:46

(if tf
(setq allpro (safearray-value
(vla-getallprofilenames
(vla-get-profiles
(vla-get-preferences (vlax-get-acad-object))
)
'Profiles
)
)
)
(setq allpro (list (getvar "cprofile")))
)

这句代码错了，应该这样写==>

(if tf
(progn
(vla-getallprofilenames
(vla-get-profiles
(vla-get-preferences (vlax-get-acad-object))
)
'Profiles
)
(setq allpro (safearray-value Profiles))
)
(setq allpro (list (getvar "cprofile")))
)

处处问题鸟 · 发表于 2013-7-9 21:12:27

本帖最后由处处问题鸟于 2013-7-9 21:14 编辑

程序似乎加不到启动组里去？？？系统 Win7 32位CAD2008

Lispboy · 发表于 2013-7-9 21:15:03

牢固发表于 2013-7-9 20:37
用不上正则吧！(vlax-product-key)得到的路径直接放后面jiu可以了！

楼主的程序里面有段是这样写的，针对那个：

(cond
登录/注册后可看大图
((= cadver "R16.0") (setq str "ACAD-201:804")) ;_CAD2004
登录/注册后可看大图
((= cadver "R16.1") (setq str "ACAD-301:804")) ;_CAD2005
登录/注册后可看大图
((= cadver "R16.2") (setq str "ACAD-4001:804")) ;_CAD2006
登录/注册后可看大图
((= cadver "R17.0") (setq str "ACAD-5001:804")) ;_CAD2007
登录/注册后可看大图
((= cadver "R17.1") (setq str "ACAD-6001:804")) ;_CAD2008
登录/注册后可看大图
((= cadver "R17.2") (setq str "ACAD-7000:409")) ;_CAD2009
登录/注册后可看大图
((= cadver "R18.0") (setq str "ACAD-8001:804")) ;_CAD2010
登录/注册后可看大图
((= cadver "R18.2") (setq str "ACAD-A001:804")) ;_CAD2012 ACAD-A005:804
登录/注册后可看大图
((= cadver "R19.0") (setq str "ACAD-B002:409")) ;_CAD2013
登录/注册后可看大图
)

Lispboy · 发表于 2013-7-9 21:16:35

处处问题鸟发表于 2013-7-9 21:12
程序似乎加不到启动组里去？？？系统 Win7 32位CAD2008

安全卫士啥的是不是给拦截了？

处处问题鸟 · 发表于 2013-7-9 21:30:22

Lispboy 发表于 2013-7-9 21:16
安全卫士啥的是不是给拦截了？

查看注册表，注册表是写进去了！打开启动组，里面没有加进去！再打开注册表，刚才写的内容就消失了！

lgttblue · 发表于 2013-7-9 21:53:19

新手学习了哈:loveliness:

Lispboy · 发表于 2013-7-9 21:56:02

处处问题鸟发表于 2013-7-9 21:30
查看注册表，注册表是写进去了！打开启动组，里面没有加进去！再打开注册表，刚才写的内容就消失了！

不打开启动组，注册表里面就一直有？只要打开启动组查看，注册表就没？

eachy · 发表于 2013-7-9 22:08:01

Windows 7 下测试通不过，vl-registry-write 返回 T 但是注册表没有写入

处处问题鸟 · 发表于 2013-7-9 22:16:53

Lispboy 发表于 2013-7-9 21:56
不打开启动组，注册表里面就一直有？只要打开启动组查看，注册表就没？

经测试，写入注册表后，不能打开启动组，需退出当前的CAD,然后再打开CAD,就可以了！

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

[系统] 写启动组

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

评分

点评

点评

点评

点评

点评

点评

点评

点评