如何建立程序的快捷方式？

wdb · 发表于 2004-7-11 06:06:00

已知exe程序的路径，如何在桌面或开始菜单中建立这个程序的快捷方式？请用vlisp编程。

无痕 · 发表于 2004-7-11 10:59:00

有必要依赖cad么？以后你干脆让cad来启动window算了

wzh · 发表于 2004-7-11 11:06:00

楼主怎么会有这种想法呢？

wdb · 发表于 2004-7-11 13:11:00

做不了就别嚷嚷

雪山飞狐_lzh · 发表于 2004-7-11 14:05:00

好像龙斑竹有过这样的帖子

wdb · 发表于 2004-7-11 17:27:00

我搜索过了，没发现。请高手帮忙啊！急用！！！

龙龙仔 · 发表于 2004-7-12 08:04:00

;;Create a windows shortcut
;;MODIFY BY 龙龙仔(LUCAS)
;;FIL = file name must have extension .lnk
;;CDIR = shortcut存於目录(目录不存在会出错)
;;TARGET = 执行档案
;;LST = DESCRIPTION
;;WDIR = WORKINGDIRECTORY
;;TAG = to overwrite it T OR NIL
;;(F:WINDOWS_SHORTCUT "CDCHECK.LNK" "C:\\LSP" "C:\\Cdcheck\\CDCheck.exe" '("CDCHECK") "C:\\LSP" T)
(defun F:WINDOWS_SHORTCUT
(FIL CDIR TARGET LST WDIR TAG / WSH LNK RET COMMENT)
(setq FIL (strcat CDIR "\" FIL))
(if (or (and (findfile FIL) TAG) (not (findfile FIL))) ;or
(progn (setq WSH (vlax-create-object "Wscript.Shell")
LNK (vlax-invoke-method WSH 'CREATESHORTCUT FIL)
) ;setq
(if (not (setq COMMENT (car LST)))
(setq COMMENT "")
)
(if (and (F:VLERR 'vlax-put-property
(list WSH 'CURRENTDIRECTORY CDIR)
NIL
)
(F:VLERR 'vlax-put-property
(list LNK 'TARGETPATH TARGET)
NIL
)
(F:VLERR 'vlax-put-property
(list LNK 'DESCRIPTION COMMENT)
NIL
)
(F:VLERR 'vlax-put-property
(list LNK 'WORKINGDIRECTORY WDIR)
NIL
) (F:VLERR 'vlax-invoke-method (list LNK 'SAVE) NIL)
) ;and
(progn (mapcar 'vlax-release-object (list WSH LNK))
(setq RET t)
) ;progn
) ;if
) ;progn
) ;if
RET
)
;;return the target path of a windows shortcut file (.lnk)
;;(F:GET_WINDOWS_SHORTCUT_PROPERTIES "cdcheck.lnk")
(defun F:GET_WINDOWS_SHORTCUT_PROPERTIES (FIL / WSH LNK PTH COM)
(if (setq FIL (findfile FIL))
(progn (setq WSH (vlax-create-object "Wscript.Shell")
LNK (vlax-invoke-method WSH 'CREATESHORTCUT FIL)
PTH (vlax-get-property LNK 'TARGETPATH)
COM (vlax-get-property LNK 'DESCRIPTION)
) ;setq
(mapcar 'vlax-release-object (list WSH LNK))
)
)
(if PTH
(list PTH COM)
NIL
)
);;simplified error catching routine for vl-catch*
;;usage (setq en (f:vlerr 'vla-get-Area (list en) nil))
;;tag = true for debugging: princes error message
(defun F:VLERR (FUN LST TAG / RET)
(if (vl-catch-all-error-p
(setq RET (vl-catch-all-apply FUN LST))
)
(if TAG
(progn (princ (vl-catch-all-error-message RET)) NIL)
NIL
)
(if (not RET)
(setq RET t)
RET
)
)
)

;;Create a windows shortcut
;;MODIFY BY 龙龙仔(LUCAS)
;;FIL = file name must have extension .lnk
;;CDIR = shortcut存於目录(目录不存在会出错)
;;TARGET = 执行档案
;;LST = DESCRIPTION
;;WDIR = WORKINGDIRECTORY
;;TAG = to overwrite it         T OR NIL
;;(F:WINDOWS_SHORTCUT   "CDCHECK.LNK" "C:\\LSP" "C:\\Cdcheck\\CDCheck.exe" '("CDCHECK") "C:\\LSP" T)   
(defun F:WINDOWS_SHORTCUT
             (FIL CDIR TARGET LST WDIR TAG / WSH LNK RET COMMENT)
   (setq FIL (strcat CDIR "\" FIL))
   (if (or (and (findfile FIL) TAG) (not (findfile FIL))) ;or
       (progn (setq WSH (vlax-create-object "Wscript.Shell")
     LNK (vlax-invoke-method WSH 'CREATESHORTCUT FIL)
       )        ;setq
       (if (not (setq COMMENT (car LST)))
           (setq COMMENT "")
       )
       (if (and (F:VLERR 'vlax-put-property
               (list WSH 'CURRENTDIRECTORY CDIR)
               NIL
           )
           (F:VLERR 'vlax-put-property
               (list LNK 'TARGETPATH TARGET)
               NIL
           )
           (F:VLERR 'vlax-put-property
               (list LNK 'DESCRIPTION COMMENT)
               NIL
           )
           (F:VLERR 'vlax-put-property
               (list LNK 'WORKINGDIRECTORY WDIR)
               NIL
           )           (F:VLERR 'vlax-invoke-method (list LNK 'SAVE) NIL)
               )      ;and
           (progn (mapcar 'vlax-release-object (list WSH LNK))
           (setq RET t)
           )        ;progn
       )        ;if
       )          ;progn
   )          ;if
   RET
)
;;return the target path of a windows shortcut file (.lnk)
;;(F:GET_WINDOWS_SHORTCUT_PROPERTIES "cdcheck.lnk")
(defun F:GET_WINDOWS_SHORTCUT_PROPERTIES (FIL / WSH LNK PTH COM)
   (if (setq FIL (findfile FIL))
       (progn (setq WSH (vlax-create-object "Wscript.Shell")
     LNK (vlax-invoke-method WSH 'CREATESHORTCUT FIL)
     PTH (vlax-get-property LNK 'TARGETPATH)
     COM (vlax-get-property LNK 'DESCRIPTION)
       )        ;setq
       (mapcar 'vlax-release-object (list WSH LNK))
       )
   )
   (if PTH
       (list PTH COM)
       NIL
   )
);;simplified error catching routine for vl-catch*
;;usage (setq en (f:vlerr 'vla-get-Area (list en) nil))
;;tag = true for debugging: princes error message
(defun F:VLERR (FUN LST TAG / RET)
   (if (vl-catch-all-error-p
  (setq RET (vl-catch-all-apply FUN LST))
           )
       (if  TAG
           (progn (princ (vl-catch-all-error-message RET)) NIL)
           NIL
       )
       (if  (not RET)
           (setq RET t)
           RET
       )
   )
)

wmz · 发表于 2004-7-12 14:18:00

贴子虽好,但我不知道怎么用!敬请指教.

wdb · 发表于 2004-7-12 19:18:00

多谢龙斑竹。

我试试看。

铆钉 · 发表于 2004-7-14 11:00:00

defun F:XXXX ()

是什么意思

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