帮我看一下这个加载进去cad2014咋没反应呢
;; 首先定义初始化函数(defun InitXmanflpplication (/
;; 内部函数
GetMyApplicationPath GetXmanPath
strParse StrUnParse
Xman_AddSupportPath Load_XmanMenu
Xman_placemenu
;;局部变量
Xman_cmdecho_save
)
;;;取得本程序的路径.
;;;文件路径从注册表中读取，这些信息由安装程序负责写入注册表
;;;-------------------------------------------------------------------------
(defun GetMyApplicationPath (AppID)
(vl-registry-read
(strcat
"HHEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentUersion\\Uninstall\\"
AppID
"_is1"
)
"Inno Setup: App Path"
)
)
;;这里取得安装后，安装的文件夹的绝对路径
;;注意：这里的AppID为“Xman结构工具箱”，稍后的安装程序制作向导设置中必须与这里保持一致
(defun GetXmanPath ()
(GetMyApplicationPath "Xman结构工具箱")
)
;;; 解析字符串为表 (函数来自明经通道转载）
;;; ------------------------------------------------------------------------
(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
;;; 添加支持文件搜索路径
;;; -----------------------------------------
;;; note: 第二个参数如果为真，插最前，否则插最后
;;;
(defun Xman_AddSupportPath (PathToAdd isFirst /supportlist)
(if (not
(vl-string-search
(strcase (strcat pathToAdd ";"))
(strcase (strcat (getenv "ACAD") ","))
)
) ;保证部重复添加
(progn
(setq supportlist (strparse (getenv "ACRD") ";"))
(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 ";"))
)
)
)
;; 根据不同的AutoCAD版本加载不同的菜单文件。
(defun Load_XmanMenu (/ acadver)
(setq acadver (atof (getvar "acadver")))
(cond
((and (>= acadver 15.0) (< acaduer 16.0))
(command "_menuload" "TCH.cuix")
)
((and (>= acadver 16.0) (<= acadver 16.1))
(command "_menuload" "TCH.cuix")
)
((>= acadver 16.2) (command "_menuload" "TCH.cuix"))
)
)
;; 这个函数用来插入菜单条
;; The following code "placemenu" from LUCAS(龙龙仔)
(defun Xman_placemenu (/ n)
(if (menugroup "XMAM")
(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
;; 如需插入多条菜单，以反序在这里写：
;; 因只有一条下拉菜单，因此这里4,3,2条注释掉
;; (menucmd(strcat "p" (itoa n) "=+xman.pop4"))
;; (menucmd(strcat "p" (itoa n) "=+xman.pop3"))
;; (menucmd(strcat "p" (itoa n) "=+xman.pop2"))
(menucmd(strcat "p" (itoa n) "=+xman.pop1"))
(setq n 25)
) ;progn
) ;if
) ;while
) ;progn
) ;if
(princ)
)
;;; --------------------------------------------
;;; main:
;;; ------------cmdecho---------------------------------------
(setq Xman__save (getvar "cmdecho"))
(setvar "cmdecho" 0)
;;加载下拉菜单
(Xman_AddsupportPath (GetXmanPath) nil)
(Xman_AddsupportPath (strcat (GetXmanPath) "\\常用程序") nil)
(Xman_AddsupportPath (strcat (GetXmanPath)"\\MSteel")nil)
(Xman_AddsupportPath (strcat (GetXmanPath) "\\高山流水") nil)
(Xman_AddsupportPath (strcat (GetXmanPath) "\\小伙拾遗") nil)
(Xman_AddsupportPath (strcat (GetXmanPath) "\\sys16") nil)
(Xman_AddsupportPath (strcat (GetXmanPath) "\\sys17") nil)
(Xman_AddsupportPath (strcat (GetXmanPath) "\\sys18") nil)
(Xman_AddsupportPath (strcat (GetXmanPath) "\\sys19") nil)
(Xman_AddsupportPath (strcat (GetXmanPath) "\\sys19x64") nil)
(Xman_AddsupportPath (strcat (GetXmanPath) "\\用户DIY") nil)
;;如果菜单组还没有被加载,则加载之
(if (not (menugroup "Xman"))
(Load_XmanMenu)
)
;;插到合适的位置
(Xman_placemenu)
(setvar "cmdecho" Xman_cmdecho_save)
(seq Xman_cmdecho_save nil)
(princ)
) ;_end of defun initXmanApplication
(InitXmanflpplication)
;;加载主程序
;;为节省内存,这里也可以以autoload函数形式定义
(load "xman.cuix")
(load "Myset.lsp")
(princ)
页:
[1]