[求助]如何把程序加入启动组

jdhszh

我是这样的，我有一个批处理生成和自动运行该批处理的程序，但程序需要调用自己写的程序，怎样用LISP语言把该程序自动放入“启动组”。

caoyin

;;____________________________________________________________________________________________________
;; ▓ (lt:acad-rootgroup-add filname)
;; [功能] 添加路径到 AutoCAD 启动组
;; [参数] filname---完整路径文件名

(defun lt:acad-rootgroup-add (filname / reg-key munstar)
  (setq reg-key (strcat "HKEY_CURRENT_USER\\" (vlax-product-key)
                        "\\Profiles\\"        (getvar "cprofile")
                        "\\Dialogs\\Appload\\Startup"
                )
        munstar (vl-registry-read reg-key "NumStartup")
  )
  (if munstar
    (setq munstar (itoa (1+ (atoi munstar))))
    (setq munstar 1)
  )
  (vl-registry-write reg-key "NumStartup" munstar)
  (vl-registry-write reg-key (strcat munstar "Startup") filname)
)

lisp爱好者

xshrimp 发表于 2008-3-14 13:03
;;读取LoadCtrls的值,将这个值与2作“或”运算，再写回。这样可以保证AutoCAD启动时会加载Appload.arx模块 ...

大侠第二段删除程序中缺少个之程序：gps->lst-delsame，能否上传

zj20190405

xshrimp 发表于 2008-3-14 13:03
;;读取LoadCtrls的值,将这个值与2作“或”运算，再写回。这样可以保证AutoCAD启动时会加载Appload.arx模块 ...

老大，删除启动组缺少GPS->LST-DELSAME函数

phoenixdjq

放到acad.lsp ; acad.mnl 中都应该可以的

jdhszh

我的意思是用程序自动加入，因为我写个小程序，别人需要用又不熟悉CAD，老是叫来叫去的麻烦，有时还要楼上楼下跑，麻烦又误事，我是想让程序自动完成这一切，省去我的功夫，那位大侠指点下。先谢谢啦！

LongZT

就像二楼说的,在acad.lsp中写一条你程序的载入语句就行了.

jaminth

caoyin,按照您提供的这几LISP试做了一遍,出现了这样一种情况,

即有时能加载,有时又不能加载的怪事情!能否再检查或完善一下!?谢谢

caoyin

这种情况我也知道，但应该不是程序问题。程序只能将相关的数据写入注册表，而无法判断CAD能否成功加载。这个在以前好像有讨论

xshrimp

xshrimp

;;读取LoadCtrls的值,将这个值与2作“或”运算，再写回。这样可以保证AutoCAD启动时会加载Appload.arx模块。

;|
cad appload.arx
处理步骤
1.读取NumStartup的值.
  1.1->不存在.建立NumStartup值为0删除其他所有键值.
  1.2->存在.从1Startup读取到NumStartupStartup的值.
      1.2.1->监测是否存在重复.重复的删除之.不检测文件是否存在及合法.
      1.2.2->其他非相关的键值全部删除.
------------------------------------------------------------------------------------------------
$skey "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R16.0\\ACAD-201:804\\Profiles\\<<未命名配置>>\\Dialogs\\Appload\\Startup"
$akey "HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R16.0\ACAD-201:804\Applications\AcadAppload
(setq appname "se.lsp")(setq appname se.lsp)
(gps->appload-filepath T)
(gps->appload-filepath "se.lsp")
(gps->appload-filepath AppName)
1. AppName 值与nstartup值相符.
2. appname T返回全部自动加载的文件列表
3. appname 文件名(需包含扩展名)或全部路径名.检查自动加载文件中是否含有该文件.
           有则返回该文件的全路径名或文件名
|;
(defun gps->appload-filepath    (AppName / $skey i keyvalue numstartup svlst x)
  (if (member (type appname) '(STR SYM))
    (progn
      (setq $skey
  (strcat  "HKEY_CURRENT_USER\\"   (vlax-product-key)      "\\Profiles\\"
        (getvar "CPROFILE")      "\\Dialogs\\Appload\\Startup"
       )
      )
      (setq NumStartup (vl-registry-read $skey "NumStartup"))
      (if (= (type NumStartup) 'STR)
 (progn
   (setq NumStartup (atoi NumStartup) i 1 )
   (repeat NumStartup
     (if (setq keyvalue (vl-registry-read $skey (strcat (itoa i) "Startup") ))
       (setq svlst (append svlst (list keyvalue))   i  (1+ i)   )
       (setq i (1+ i))
     )
   );end repeat
   (if svlst   (setq svlst (mapcar 'strcase svlst)));end if
 )
      )
      (if svlst     
 (cond ((= T appname) svlst)
       (T (car (member (strcase appname) svlst)))
 );end cond
      )
    )
  );end if
)
;|
(gps->appload-deletefile "se.lsp")
(gps->appload-deletefile "D:\\PROGRAM FILES\\SHLISP2006\\自编备份程序\\LRR\\LRR1.FAS")
(gps->appload-deletefile "D:\\PROGRAM FILES\\SHLISP2006\\自编备份程序\\LRR\\LRR2.FAS1")
|;
(defun gps->appload-deletefile (AppName / $skey n num svlst)
(if (and (= (type appname) 'STR)  (gps->appload-filepath AppName))
  (progn
    (setq
     $skey (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Profiles\\" (getvar "CPROFILE") "\\Dialogs\\Appload\\Startup")
    )
    (setq svlst (gps->lst-delsame (gps->appload-filepath T)) num 1)
    (setq svlst (vl-remove (strcase AppName) svlst)) 
    (foreach n svlst
     (vl-registry-write $skey (strcat (itoa num) "Startup") n)
        (setq num (1+ num))  
    )
    (vl-registry-delete $skey (strcat (itoa num) "Startup"))
    (vl-registry-write $skey "NumStartup" (itoa (length svlst)))
    T
  )
nil
);end if
)
;;;------------------------------------------------------------------------------------------------
;|
(gps->appload-addfile "se.lsp")
(gps->appload-addfile "D:\\PROGRAM FILES\\SHLISP2006\\自编备份程序\\LRR\\LRR2.FAS1")
|;
(defun gps->appload-addfile (AppName / $akey $skey loadctrlnum numstartup)
(if (and (= (type appname) 'STR) (null (gps->appload-filepath AppName)))
(progn
  (setq
   $skey (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Profiles\\" (getvar "CPROFILE") "\\Dialogs\\Appload\\Startup")
   $akey (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Applications\\AcadAppload" )
  )
  (setq NumStartup (vl-registry-read $skey "NumStartup"))
  (if NumStartup
    (progn
    (vl-registry-write $skey "NumStartup" (itoa (+ 1 (atoi NumStartup))))
    (vl-registry-write $skey (strcat (itoa (+ 1 (atoi NumStartup))) "Startup") AppName )
    )
    (progn
    (vl-registry-write $skey "NumStartup" "1")
    (vl-registry-write $skey "1Startup" AppName )
    )
  )
 ;;读取LoadCtrls的值,将这个值与2作“或”运算，再写回。这样可以保证AutoCAD启动时会加载Appload.arx模块。
 (setq loadctrlnum (vl-registry-read $akey "LOADCTRLS"))
 (if loadctrlnum
  (vl-registry-write $akey "LOADCTRLS" (Boole 7 loadctrlnum 2))
  (vl-registry-write $akey "LOADCTRLS" 15)
 )
T
)
nil
);end if
)

wangph

如果把程序移出启动组可能就没那么简单了吧，请高手给个例子。