[原创]：加载菜单时自动添加菜单所在的路径

eachy

放到和菜单同名的Mnl文件中，并在加载文件之前调用 (ea:addsupport)
[PHP]
(defun Ea:Addsupport (/ getactiveprofile mnus name n m path mnupath)
  (defun getActiveProfile ()
    (strcat "HKEY_CURRENT_USER\\"
            (vlax-product-key)
            "\\PROFILES\\"
            (vla-get-activeprofile
              (vla-get-profiles
                (vla-get-preferences (vlax-get-acad-object))
              )
            )
    )
  )
  (setq
    mnus (vlax-get-property
           (vlax-get-property (vlax-get-acad-object) "application")
           "menugroups"
         )
  )
  (vlax-for x mnus
    (setq name (cons (vla-get-name x) name))
  )
  (setq        n 1
        m (length name)
  )
  (repeat m
    (if        (setq mnupath (vl-registry-read
                             (strcat (getActiveProfile)
                                     "\\Menus"
                             )
                             (strcat "group" (itoa n))
                           )
             )   
      (progn
        (if (Wcmatch mnupath "EATOOLS ")
          (progn
            (setq mnupath (substr (strcase mnupath) 9)
                  path          (vl-filename-directory mnupath)
            )          (if (not (wcmatch (strcase (getenv "ACAD")) "*EATOOLS*"))
            (setenv "ACAD" (strcat (getenv "ACAD") ";" path))
          )
        )
      )
    )
    (setq n (1+ n))
  )
)[/PHP]

陌生人

好帖子，加分加分！！

bububa918

好像多了个括号

懒虫

请问在2006里怎么办？上面程序好象不行。

eachy

2006下不能用读注册表的方法，要改成 vla-get-menugroups

xyz518mm

请问一下eachy版主

是否是将

(setq
    mnus (vlax-get-property
       (vlax-get-property (vlax-get-acad-object) "application")
       "menugroups"
     )
  )
    中的   "menugroups"  改成  vla-get-menugroups
这样就可以了呢
另外这段描述 怎样加载到cad中呢
烦请解答一下
感谢

yuer0103

好东西好东西，俺的东西又可以简化多多了！谢！！

懒虫

2006下的问题解决了，
给个例子：

2. 
   
3. (defun wltoolssupport (menuname mfilename / mnus path)
   
4.   (setq
   
5.     mnus (vlax-get-property
   
6.            (vlax-get-property (vlax-get-acad-object) "application")
   
7.            "menugroups"
   
8.          )
   
9.   )
   
10.   (setq path "non")
    
11.   (vlax-for x mnus
    
12.     (if        (= (strcase (vla-get-Name x) T)(strcase menuname T))
    
13.       (setq path (strcase (vla-get-MenuFileName x) T))
    
14.     )
    
15.   )
    
16.   (setq path (vl-string-right-trim (strcat ".cui") path))
    
17.   (setq path (vl-string-right-trim (strcat ".mnc") path))
    
18.   (setq path (vl-string-right-trim (strcat mfilename) path))
    
19. )
    

<br /> (defun wltoolssupport (menuname mfilename / mnus path)<br />   (setq<br />     mnus (vlax-get-property<br />            (vlax-get-property (vlax-get-acad-object) "application")<br />            "menugroups"<br />          )<br />   )<br />   (setq path "non")<br />   (vlax-for x mnus<br />     (if        (= (strcase (vla-get-Name x) T)(strcase menuname T))<br />       (setq path (strcase (vla-get-MenuFileName x) T))<br />     )<br />   )<br />   (setq path (vl-string-right-trim (strcat ".cui") path))<br />   (setq path (vl-string-right-trim (strcat ".mnc") path))<br />   (setq path (vl-string-right-trim (strcat mfilename) path))<br /> )<br />