[求助]右鍵菜單

cjun2258 · 发表于 2010-2-4 15:08:00

我是用“Mouse Reactor.lsp”改的,

SY是已加載的菜單組，在已加載的菜單組中添加快捷菜單

但我碰到兩個問題：

1. (menucmd (strcat "P0=" "sy" ".pop2"))
(menucmd "P0=*")

menucmd語句中不能用別名,隻能用POPn來調用

2. (defun c:f1 ()
      (setq Item1 (sy-addCustomPopupMenu '("AA" "BB" "CC")))
      (cond ((= Item1 1) (princ "A1"))
               ((= Item1 2) (princ "B1"))
               ((= Item1 3) (princ "C1"))
              )
      )

以上面為例，雖能顯示菜單，但f1執行完後才執行菜單宏

以上面兩個問題誰幫幫我，

小弟先謝了!

sy-addCustomPopupMenu 函數在2樓

cjun2258 · 发表于 2010-2-4 15:09:00

(setvar "cmdecho" 0)
;;; --------------------------------------------------------------------------
;;; searches for a popup label in a popupmenu object
;;; returns the popupmenu object is it exists.
(defun ac:MenuPopExist (MenuGroupObject popupLabel / dl)
(vlax-for item MenuGroupObject
(setq dl (cons (list (strcase (vla-get-NameNoMnemonic item))
item)
dl)
)
)
(cadr (assoc (strcase popuplabel) dl))
)
;;; --------------------------------------------------------------------------
;;; searches for an id string label in a popupmenuitem object
;;; returns the popupmenu object is it exists.
(defun ac:MenuItemLabelExist (MenuPopupObject itemLabel / dl)
(vlax-for item MenuPopupObject
(setq dl (cons (list (strcase (vla-get-TagString item)) item)
dl)
)
)
(cadr (assoc (strcase itemLabel) dl))
)
;;; --------------------------------------------------------------------------
;;; returns a list of all menuitem objects contained within a popupmenu object
(defun ac:get-Menu-Items (popup / dl)
(if popup
(progn
(vlax-for MenuItem POpup
(setq dl (cons MenuItem dl))
)
(reverse dl)
)
)
)
;;; --------------------------------------------------------------------------
;;; returns a menuObject. The parameter must be a valid menugroup
(defun ac:ReturnMenuObject (MenuName / dl)
(if (menugroup MenuName)
(progn
(setq meuns (vla-get-MenuGroups (vlax-get-acad-object)))
(vlax-for Item meuns
(setq dl (cons (list (strcase (vla-get-name item)) item) dl))
)
(cadr (assoc (strcase MenuName) dl))
)
)
)
;;; --------------------------------------------------------------------------
;;; Predicate for a string
;;; Returns T if successfull nil otherwise.
(defun vlaxx-string-p (arg)
(and (equal (type arg) 'str))
)
;;; --------------------------------------------------------------------------
;;; Predicate for an integer
;;; Returns T if successfull nil otherwise.
(defun vlaxx-integer-p (arg)
(and (equal (type arg) 'int))
)
;;; --------------------------------------------------------------------------
;;; Predicate for a real number
;;; Returns T if successfull nil otherwise.
(defun vlaxx-real-p (arg)
(and (equal (type arg) 'real))
)
;;; --------------------------------------------------------------------------
;;;添加菜單項到彈出對象。此功能是相同的vla-AddMenuItem ,只是執行錯誤檢查。
;;;返回菜單項對象，如果成功。如果遇到錯誤的錯誤信息，並打印函數返回零。
(defun AddMenuItem (ParentMenuObject Index Label Macro / res)
;;(print (list ParentMenuObject Index Label Macro))
(if (and (vlaxx-string-p Label)
(or (vlaxx-integer-p Index)
(vlaxx-string-p Index)
(equal (vlax-variant-type Index) 2);; is it a variant integer? 它是一個變體整數
(equal (vlax-variant-type Index) 8);; is it a variant String? 它是一個變體字符
)
(vlaxx-string-p Macro)
)
;; now check for pop menu Object 現在檢查彈出功能表物件
(if (and (equal (type ParentMenuObject) 'vla-object)
;; Check if its a IAcadPopupMenu: 檢查的一個IAcadPopupMenu:
(vlax-property-available-p ParentMenuObject "ShortcutMenu")
)
(progn
(setq res (vla-AddMenuItem ParentMenuObject Index Label Macro))
)
(princ "\n錯誤:ParentMenuObject不是一個有效的功能表物件")
)
(princ "\n錯誤:索引，標籤或不正確宏")
)
res
)
;;; --------------------------------------------------------------------------
;;; Adds a specific custom popup menu 增加了一個特定的自定義彈出功能表
;;; to AutoCAD. Returns the newly created popupmenu Object. 到AutoCAD。返回新創建的彈出式功能表物件
;;(setq Item (sy-addCustomPopupMenu '("AA" "--" ">CC" "C1" "C2" "<C3" "BB")))
(defun sy-addCustomPopupMenu (menulst / acadMenuObject acadPopupMenuGroup NextItem)
(UnLoadMenuGroup)
(if (or (null *Custom-Popup*)
(null (ac:get-Menu-Items *Custom-Popup*))
)
(progn
(setq acadMenuObject (ac:ReturnMenuObject "SY")
acadPopupMenuGroup (vla-get-Menus acadMenuObject)
)
(if (not (ac:MenuPopExist acadPopupMenuGroup "Custom-Menu"))
(setq *Custom-Popup* (vla-add acadPopupMenuGroup "Custom-Menu"))
)
(setq ItemLstMun 0
Sublstmun 0
)
(foreach N menulst
(setq lstmun (1+ (vla-get-count *Custom-Popup*)))
(if (= (type N) (quote str))
(progn
(setq JudgeStr (substr N 1 1))
(cond ((= JudgeStr "-") (vla-addseparator *Custom-Popup* lstmun))
((= JudgeStr ">")
(setq ItemLstMun (+ ItemLstMun 1))
(setq SubMenu (vla-AddSubMenu *Custom-Popup* lstmun (substr N 2)))
(setq NextItem T)
)
((or (/= JudgeStr "-") (/= JudgeStr ">"))
(if NextItem
(progn
(if SubItemLstMun
(setq SubItemLstMun (+ SubItemLstMun 0.1))
(setq SubItemLstMun (+ ItemLstMun 0.1))
)
(setq Sublstmun (+ Sublstmun 1))
(if (= JudgeStr "<")
(setq N (substr N 2))
)
(setq NewSubItem (AddMenuItem SubMenu
Sublstmun
N
(strcat (CHR 3) (CHR 3) (CHR 16) "(SetItemMun " (rtos SubItemLstMun 2 1) ")" (CHR 32) (CHR 16)))
)
(vla-put-helpstring NewSubItem N)
(if (= JudgeStr "<")
(setq NextItem nil
SubItemLstMun nil
Sublstmun 0
)
)
)
(progn
(setq ItemLstMun (+ ItemLstMun 1))
(setq NewItem (AddMenuItem *Custom-Popup*
lstmun
N
;;"(SetItemMun 3) ")
(strcat (CHR 3) (CHR 3) (CHR 16) "(SetItemMun " (itoa ItemLstMun) ")" (CHR 32) (CHR 16)))
)
(vla-put-helpstring NewItem N)
)
)
)
)
)
)
)
;;(vla-SaveAs acadMenuObject "d:/temp.mns" acPartialMenuGroup)acMenuFileSource
)
)
(menucmd (strcat "P0=" "sy" ".pop2"))
(menucmd "P0=*")
(princ)
)
;;; --------------------------------------------------------------------------
;;; disables the custom popup menu 禁用自定義彈出菜單
(defun UnLoadMenuGroup ()
(if *Custom-Popup*
(progn
(mapcar 'vla-delete (ac:get-Menu-Items *Custom-Popup*))
(menucmd "p0=acad.pop0") ;;;返回到acad系統pop0
)
)
(princ)
)
(defun c:f1 ()
(setq Item1 (sy-addCustomPopupMenu '("AA" "BB" "CC")))
(cond ((= Item1 1) (princ "A1"))
((= Item1 2) (princ "B1"))
((= Item1 3) (princ "C1"))
)
)
(defun SetItemMun (Value)
(setq Item Value)
)

(setvar "cmdecho" 0)
;;; --------------------------------------------------------------------------
;;; searches for a popup label in a popupmenu object
;;; returns the popupmenu object is it exists.
(defun ac:MenuPopExist (MenuGroupObject popupLabel / dl)
      (vlax-for item MenuGroupObject
     (setq dl (cons (list (strcase (vla-get-NameNoMnemonic item))
     item)
      dl)
     )
      )
      (cadr (assoc (strcase popuplabel) dl))
)
;;; --------------------------------------------------------------------------
;;; searches for an id string label in a popupmenuitem object
;;; returns the popupmenu object is it exists.
(defun ac:MenuItemLabelExist (MenuPopupObject itemLabel / dl)
      (vlax-for item   MenuPopupObject
     (setq dl (cons (list (strcase (vla-get-TagString item)) item)
      dl)
    )
     )
      (cadr (assoc (strcase itemLabel)  dl))
  )
;;; --------------------------------------------------------------------------
;;; returns a list of all menuitem objects contained within a popupmenu object
(defun ac:get-Menu-Items (popup / dl)
      (if popup
     (progn
    (vlax-for MenuItem POpup
   (setq dl (cons MenuItem dl))
    )
    (reverse dl)
     )
      )
)
;;; --------------------------------------------------------------------------
;;; returns a menuObject. The parameter must be a valid menugroup
(defun ac:ReturnMenuObject (MenuName / dl)
      (if (menugroup MenuName)
     (progn
    (setq meuns (vla-get-MenuGroups (vlax-get-acad-object)))
    (vlax-for Item meuns
   (setq dl (cons (list (strcase (vla-get-name item)) item) dl))
    )
    (cadr (assoc (strcase MenuName) dl))
     )
      )
)
;;; --------------------------------------------------------------------------
;;; Predicate for a string
;;; Returns T if successfull nil otherwise.
(defun vlaxx-string-p (arg)
  (and (equal (type arg) 'str))
  )
;;; --------------------------------------------------------------------------
;;; Predicate for an integer 
;;; Returns T if successfull nil otherwise.
(defun vlaxx-integer-p (arg)
  (and (equal (type arg) 'int))
  )
;;; --------------------------------------------------------------------------
;;; Predicate for a real number
;;; Returns T if successfull nil otherwise.
(defun vlaxx-real-p (arg)
  (and (equal (type arg) 'real))
  )
;;; --------------------------------------------------------------------------
;;;添加菜單項到彈出對象。此功能是相同的vla-AddMenuItem ,只是執行錯誤檢查。
;;;返回菜單項對象，如果成功。如果遇到錯誤的錯誤信息，並打印函數返回零。
(defun AddMenuItem (ParentMenuObject Index Label Macro / res)
      ;;(print (list ParentMenuObject Index Label Macro))
      (if (and (vlaxx-string-p Label)
        (or (vlaxx-integer-p Index)
     (vlaxx-string-p Index)
     (equal (vlax-variant-type Index) 2);; is it a variant integer? 它是一個變體整數
     (equal (vlax-variant-type Index) 8);; is it a variant String? 它是一個變體字符
     )
        (vlaxx-string-p Macro)
        )
   ;; now check for pop menu Object 現在檢查彈出功能表物件
   (if (and (equal (type ParentMenuObject) 'vla-object)
     ;; Check if its a IAcadPopupMenu: 檢查的一個IAcadPopupMenu:
     (vlax-property-available-p ParentMenuObject "ShortcutMenu")
     )
       (progn
      (setq res (vla-AddMenuItem ParentMenuObject Index Label Macro))
      )
       (princ "\n錯誤:ParentMenuObject不是一個有效的功能表物件")
       )
   (princ "\n錯誤:索引，標籤或不正確宏")
   )
      res
      )
;;; --------------------------------------------------------------------------
;;; Adds a specific custom popup menu 增加了一個特定的自定義彈出功能表
;;; to AutoCAD. Returns the newly created popupmenu Object. 到AutoCAD。返回新創建的彈出式功能表物件
;;(setq Item (sy-addCustomPopupMenu '("AA" "--" ">CC" "C1" "C2" "<C3" "BB")))
(defun sy-addCustomPopupMenu (menulst / acadMenuObject acadPopupMenuGroup NextItem)
      (UnLoadMenuGroup)
      (if (or (null *Custom-Popup*)
       (null (ac:get-Menu-Items *Custom-Popup*))
   )
     (progn
    (setq acadMenuObject    (ac:ReturnMenuObject "SY")
   acadPopupMenuGroup (vla-get-Menus acadMenuObject)
    )
    (if (not (ac:MenuPopExist acadPopupMenuGroup "Custom-Menu"))
        (setq *Custom-Popup* (vla-add acadPopupMenuGroup "Custom-Menu"))
    )
    (setq ItemLstMun 0
   Sublstmun 0
   )
    (foreach N menulst
   (setq lstmun (1+ (vla-get-count *Custom-Popup*)))
   (if (= (type N) (quote str))
       (progn
      (setq JudgeStr (substr N 1 1))
      (cond ((= JudgeStr "-") (vla-addseparator *Custom-Popup* lstmun))
     ((= JudgeStr ">")
      (setq ItemLstMun (+ ItemLstMun 1))
      (setq SubMenu (vla-AddSubMenu *Custom-Popup* lstmun (substr N 2)))
      (setq NextItem T)
      )
     ((or (/= JudgeStr "-") (/= JudgeStr ">"))
      (if NextItem
          (progn
         (if SubItemLstMun
             (setq SubItemLstMun (+ SubItemLstMun 0.1))
             (setq SubItemLstMun (+ ItemLstMun 0.1))
             )
         (setq Sublstmun (+ Sublstmun 1))
         (if (= JudgeStr "<")
             (setq N (substr N 2))
             )
         (setq NewSubItem (AddMenuItem SubMenu
                         Sublstmun
                         N
                         (strcat (CHR 3) (CHR 3) (CHR 16) "(SetItemMun " (rtos SubItemLstMun 2 1) ")" (CHR 32) (CHR 16)))
        )
         (vla-put-helpstring NewSubItem N)
         (if (= JudgeStr "<")
             (setq NextItem nil
            SubItemLstMun nil
            Sublstmun 0
            )
             )
         )
          (progn
         (setq ItemLstMun (+ ItemLstMun 1))
         (setq NewItem (AddMenuItem *Custom-Popup*
                      lstmun
                      N
                      ;;"(SetItemMun 3) ")
                      (strcat (CHR 3) (CHR 3) (CHR 16) "(SetItemMun " (itoa ItemLstMun) ")" (CHR 32) (CHR 16)))
        )
         (vla-put-helpstring NewItem N)
         )
          )
      )
     )
      )
       )
   )
    ;;(vla-SaveAs acadMenuObject "d:/temp.mns"  acPartialMenuGroup)acMenuFileSource
    )
   )
      (menucmd (strcat "P0=" "sy" ".pop2"))
      (menucmd "P0=*")
      (princ)
  )
;;; --------------------------------------------------------------------------
;;; disables the custom popup menu 禁用自定義彈出菜單
(defun UnLoadMenuGroup ()
      (if *Custom-Popup*
     (progn
    (mapcar 'vla-delete (ac:get-Menu-Items *Custom-Popup*)) 
    (menucmd "p0=acad.pop0") ;;;返回到acad系統pop0
     )
      )
      (princ)
)
(defun c:f1 ()
      (setq Item1 (sy-addCustomPopupMenu '("AA" "BB" "CC")))
      (cond ((= Item1 1)  (princ "A1"))
     ((= Item1 2)  (princ "B1"))
     ((= Item1 3)  (princ "C1"))
     )
      )

(defun SetItemMun (Value)
      (setq Item Value)
)

liminnet · 发表于 2010-2-4 16:12:00

提示: 作者被禁止或删除内容自动屏蔽

yyzhan12 · 发表于 2010-2-5 08:57:00

AutoCAD右键快捷菜单动态自定义、加载、调用函数

http://www.xdcad.net/forum/showthread.php?s=&threadid=614571

cjun2258 · 发表于 2010-2-5 17:58:00

如果用他個程序就不自已寫了，就想學習寫一個，可惜想了好久沒搞出來，所以請高手指點一下

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

liminnet liminnet 当前离线积分 9754 明经币个注册时间 2007-8-22 在线时间小时威望金钱个贡献激情	发表于 2010-2-4 16:12:00 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对使用道具举报显身卡

[函数] [求助]右鍵菜單