用秋枫老大的程序打包为何不能添加到搜索支持路径？
CAD为2014、2016版，用下文代码为何不能添加搜索支持路径？请各位老大指正啊.(defun InitCttApplication (/
GetMyApplicationPath GetCttPath
strParse StrUnParse
Ctt_AddSupportPath Load_CttMenu
ctt_placemenu
Ctt_cmdecho_save
)
(defun GetMyApplicationPath (AppID)
(vl-registry-read
(strcat
"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\"
AppID
"_is1"
)
"Inno Setup: App Path"
)
)
(defun GetCttPath ()
(GetMyApplicationPath "SCAD")
)
(defun strParse (Str Delimiter / SearchStr StringLen return n char)
(setq SearchStr Str)
(setq StringLen (strlen SearchStr))
(setq return '())
(while (> StringLen 0)
(setq n 1)
(setq char (substr SearchStr 1 1))
(while (and (/= char Delimiter) (/= char ""))
(setq n (1+ n))
(setq char (substr SearchStr n 1))
) ;_ end of while
(setq return (cons (substr SearchStr 1 (1- n)) return))
(setq SearchStr (substr SearchStr (1+ n) StringLen))
(setq StringLen (strlen SearchStr))
) ;_ end of while
(reverse return)
) ;_ end of defun
(defun StrUnParse (Lst Delimiter / return)
(setq return "")
(foreach str Lst
(setq return (strcat return Delimiter str))
) ;_ end of foreach
(substr return 2)
) ;_ end of defun
(defun Ctt_AddSupportPath (PathToAdd isFirst / supportlist)
(if (not
(vl-string-search
(strcase (strcat pathToAdd ";"))
(strcase (strcat (getenv "ACAD") ";"))
)
)
(progn
(setq supportlist (strparse (getenv "ACAD") ";"))
(setq supportlist
(vl-remove-if-not
'vl-file-directory-p
supportlist
)
)
(if isFirst
(setq supportlist (cons PathToAdd supportlist))
(setq supportlist (append supportlist (list PathToAdd)))
)
(setenv "ACAD" (strUnParse supportlist ";"))
)
)
)
(defun Load_CttMenu (/ acadver)
(setq acadver (atof (getvar "acadver")))
(cond
((and (>= acadver 15.0) (< acadver 16.0))
(command "_menuload" "ST.mns")
)
((and (>= acadver 16.0) (<= acadver 16.1))
(command "_menuload" "ST04.mns")
)
((>= acadver 16.2) (command "_menuload" "ST06.mns"))
)
)
(defun ctt_placemenu (/ n)
(if (menugroup "SHIPTools")
(progn
(setq n 1)
(while (< n 24)
(if (menucmd (strcat "P" (itoa n) ".1=?"))
(setq n (+ n 1))
(progn
(if (> n 3)
(setq n (- n 2))
(setq n 3)
) ;if
;; (menucmd (strcat "p" (itoa n) "=+STools.pop4"))
;; (menucmd (strcat "p" (itoa n) "=+STools.pop3"))
;; (menucmd (strcat "p" (itoa n) "=+STools.pop2"))
(menucmd (strcat "p" (itoa n) "=+STools.pop1"))
(setq n 25)
) ;progn
) ;if
) ;while
) ;progn
) ;if
(princ)
)
;;; -----------------------------------------------------
;;; main：
;;; -----------------------------------------------------
(setq Ctt_cmdecho_save (getvar "cmdecho"))
(setvar "cmdecho" 0)
(Ctt_AddSupportPath (GetCttPath) nil)
(Ctt_AddSupportPath (strcat (GetCttPath) "\\Program") nil)
(if (not (menugroup "STools"))
(Load_CttMenu)
)
(ctt_placemenu)
(setvar "cmdecho" Ctt_cmdecho_save)
(setq Ctt_cmdecho_save nil)
(princ "\n……加载 SCAD工具箱 v1.0……\n")
) ;_end of defun initCttApplication
(initCttApplication)
(load "SLayer.lsp")
(load "STools.lsp")
(princ)
;;; -----------------------------------------------------
;;; other：
;;; -----------------------------------------------------
你要去试着看懂代码, ...... jltx123456 发表于 2016-3-3 08:23 static/image/common/back.gif
你要去试着看懂代码, ......
搞定了。。。。
页:
[1]