lisp创建自定义工具栏

vlisp2012 · 发表于 2012-4-9 19:21:50

执行不了啊？！！！！
暂未开源？！！！

sachindkini · 发表于 2012-4-9 19:37:42

Dear sir,
see this code i think use full for create u r task

;;;-===-==-==-==-=-==-==-==-=-==-==-=-==-==-=-==-==-=-==-==-=-==-=-==-
;;; (crpd:loadDynamicPopUpMenu '("Mymenu"(("Do Command1" . "command1")("Do Command2" . "command2"))))
;;;-===-==-==-==-=-==-==-==-=-==-==-=-==-==-=-==-==-=-==-==-=-==-=-==-
(defun crpd:loaddynamicpopupmenu (menulist /
acadapp cmd
currmenugroup
doc loadedmenulist
menu newmenu
)
(vl-load-com)
(setq acadapp (vlax-get-acad-object)
loadedmenulist '()
doc (vla-get-activedocument acadapp)
currmenugroup (vla-item (vla-get-menugroups
(vla-get-application doc)
)
"ACAD"
)
cmd (lambda (x)
(strcat "\033\033\137" x "\040")
)
)
(if (/= currmenugroup nil)
(progn
(vlax-for menu (vla-get-menus currmenugroup)
(setq loadedmenulist
(cons
(vla-get-namenomnemonic menu)
loadedmenulist
)
)
)
(if (= (vl-position (car menulist) loadedmenulist) nil)
(progn
(setq newmenu (vla-add (vla-get-menus currmenugroup)
(car menulist)
)
)
(foreach e (car (cdr menulist))
(vla-addmenuitem
newmenu
(1+ (vla-get-count newmenu))
(car e)
(cmd (cdr e))
)
)
(vla-insertinmenubar
newmenu
(1+ (vla-get-count
(vla-get-menubar acadapp)
)
)
)
)
(princ (strcat "\nerror of type ohno "
(car menulist)
" menu is already loaded "
)
)
)
)
)
(princ)
)

;;;-===-==-==-==-=-==-==-==-=-==-==-=-==-==-=-==-==-=-==-==-=-==-=-==- 
;;; (crpd:loadDynamicPopUpMenu '("Mymenu"(("Do Command1" . "command1")("Do Command2" . "command2")))) 
;;;-===-==-==-==-=-==-==-==-=-==-==-=-==-==-=-==-==-=-==-==-=-==-=-==- 
(defun crpd:loaddynamicpopupmenu (menulist     / 
                                  acadapp      cmd 
                                  currmenugroup 
                                  doc          loadedmenulist 
                                  menu         newmenu 
                                 ) 
  (vl-load-com) 
  (setq acadapp        (vlax-get-acad-object) 
        loadedmenulist '() 
        doc            (vla-get-activedocument acadapp) 
        currmenugroup  (vla-item (vla-get-menugroups 
                                   (vla-get-application doc) 
                                 ) 
                                 "ACAD" 
                       ) 
        cmd            (lambda (x) 
                         (strcat "\033\033\137" x "\040") 
                       ) 
  ) 
  (if (/= currmenugroup nil) 
    (progn 
      (vlax-for menu (vla-get-menus currmenugroup) 
        (setq loadedmenulist 
               (cons 
                 (vla-get-namenomnemonic menu) 
                 loadedmenulist 
               ) 
        ) 
      ) 
      (if (= (vl-position (car menulist) loadedmenulist) nil) 
        (progn 
          (setq newmenu (vla-add (vla-get-menus currmenugroup) 
                                 (car menulist) 
                        ) 
          ) 
          (foreach e (car (cdr menulist)) 
            (vla-addmenuitem 
              newmenu 
              (1+ (vla-get-count newmenu)) 
              (car e) 
              (cmd (cdr e)) 
            ) 
          ) 
          (vla-insertinmenubar 
            newmenu 
            (1+ (vla-get-count 
                  (vla-get-menubar acadapp) 
                ) 
            ) 
          ) 
        ) 
        (princ (strcat "\nerror of type ohno " 
                       (car menulist) 
                       " menu is already loaded " 
               ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

longer1000 · 发表于 2012-4-10 08:59:41

谢谢！

方向 · 发表于 2012-4-13 17:45:46

好好学习下，谢谢了

changyiran · 发表于 2012-4-16 17:16:51

有个疑问，(open "TEMPTOOLBAR.mnu" "W")这一句是将mnu文件建在哪个位置了，因为cad搜索目录有好多个。还有能不能直接在所加载程序路径创建这个文件？

changyiran · 发表于 2012-4-16 20:29:37

changyiran 发表于 2012-4-16 17:16
有个疑问，(open "TEMPTOOLBAR.mnu" "W")这一句是将mnu文件建在哪个位置了，因为cad搜索目录有好多个。还有 ...

这个路径貌似不好取得，其实如果能取得cad下面的backup的路径也是很好的，可惜我不会取得。能不能指教下？

langjs · 发表于 2012-4-16 21:47:37

changyiran 发表于 2012-4-16 20:29
这个路径貌似不好取得，其实如果能取得cad下面的backup的路径也是很好的，可惜我不会取得。能不能指教下？ ...

(defun getlsppath (/ lsppath)       ; 读取运行程序路径并加到cad支持路径_by:wzh，如果运行的是vlx，要把程序里边的lsp改为vlx
(setq lsppath (vl-registry-read "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\ComDlg32\\OpenSaveMRU\\lsp"
                                 (substr (vl-registry-read "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\ComDlg32\\OpenSaveMRU\\lsp"
                                                            "MRUList"
                                          ) 1 1
                                 )
               )
)
(setenv "ACAD" (strcat (getenv "ACAD") ";" (vl-filename-directory lsppath)))
lsppath
  )

changyiran · 发表于 2012-4-17 08:39:28

langjs 发表于 2012-4-16 21:47
(defun getlsppath (/ lsppath) ; 读取运行程序路径并加到cad支持路径_by:wzh，如果运行的是vlx， ...

我试验了下，很正确，只是自己目前有些地方还看不懂，先留着，以后慢慢吸收！

xieling888 · 发表于 2012-4-17 09:59:58

谢谢分享，值得学习！

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

[经验] lisp创建自定义工具栏

点评