明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1865|回复: 0

[提问] 帮我看一下这个加载进去cad2014咋没反应呢

[复制链接]
发表于 2014-11-24 15:17:11 | 显示全部楼层 |阅读模式
;; 首先定义初始化函数
(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)


您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-12-23 22:09 , Processed in 0.249369 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表