[Елпанов Евгений]

Привет всем!
Прошу вас запустить функцию на своем акаде.
Мне нужна статистика - на каких версиях и языках она работает...
Я проверил на 2004 и 2007 En. - работает, но не уверен, что работает на локализованных версиях и на версиях старше 2004.
После запуска - нужно нажать правую кнопку мышы, появится контекстное меню выбора привязки, выбрать любой пункт. Появится сообщение с названием привязки, в формате командной строки, можно снова вызвать контекстное меню. Для выхода - нажмите левой кнопкой мыши в любом месте экрана...

Код:

[Выделить все]

(defun c:test (/ d lst)
 (princ "\n Нажмите правую кнопку мыши, для вызова контекстного меню.")
 (setq lst (reverse
            (menu-index
             ((lambda (x) (list (1- (vla-get-count x)) x))
              (vla-item
               (vla-get-menus
                (vla-item
                 (vla-get-menugroups
                  (vlax-get-acad-object)
                  ) ;_  vla-get-MenuGroups
                 "ACAD"
                 ) ;_  vla-item
                ) ;_  vla-get-Menus
               "&Object Snap Cursor Menu"
               ) ;_  vla-item
              )
             ) ;_  menu-index
            ) ;_  reverse
       ) ;_  setq
 (while (or (= (car (setq d (grread t 5))) 5)
            (= (car d) 11)
            (= (car d) 12)
            (= (car d) 25) ; For old version AutoCad
            ) ;_  or
  (cond
   ((= (car d) 25) (menucmd "POP0=*")) ; For old version AutoCad
   ((equal d '(11 0)) (menucmd "POP0=*"))
   ((= (car d) 11) (alert (nth (- (cadr d) 500) lst)))
   ) ;_  cond
  ) ;_  while
 (princ)
 )
(defun menu-index (l)
;|
(menu-index
 ((lambda (x) (list (1-(vla-get-count x)) x))
  (vla-item
   (vla-get-menus
    (vla-item
     (vla-get-menugroups
      (vlax-get-acad-object)
      ) ;_  vla-get-MenuGroups
     "ACAD"
     ) ;_  vla-item
    ) ;_  vla-get-Menus
   "&Object Snap Cursor Menu"
   ) ;_  vla-item
  )
 ) ;_  menu-index
 |;
 (if (not (minusp (car l)))
  (cond
   ((= (vla-get-type (vla-item (cadr l) (car l))) 0)
    (cons
     (vla-get-macro (vla-item (cadr l) (car l)))
     (menu-index (cons (1- (car l)) (cdr l)))
     ) ;_  cons
    )
   ((= (vla-get-type (vla-item (cadr l) (car l))) 1)
    (menu-index (cons (1- (car l)) (cdr l)))
    )
   ((= (vla-get-type (vla-item (cadr l) (car l))) 2)
    (append
     (menu-index
      ((lambda (x) (list (1-(vla-get-count x)) x))
       (vla-get-submenu (vla-item (cadr l) (car l)))
       ) ;_  menu-index
      )
      (menu-index (cons (1- (car l)) (cdr l)))
     ) ;_  append
    )
   ) ;_  cond
  ) ;_  if
 )

Спасибо!

[AY]

В 2005 En - работает.

[Елпанов Евгений]

Сообщение от AY В 2005 En - работает.

Спасибо!

[Pilot]

Acad 2005 eng.
У меня выскакивет вот это:
[ATTACH]1160562037.jpg[/ATTACH]
Похоже, это не то что нужно.

[Кулик Алексей aka kpblc]

ADT 2006 Rus: не работает в представленном виде. Надо поменять "&Object Snap Cursor Menu" на "&Контекстное меню привязки". То есть надо учитывать возможные варианты локализации, например, через (vlax-poduct-key), например, так:

Код:

[Выделить все]

(if (vl-string-search "419" (vlax-product-key))
    ;; Русская версия, меняем имя типа линии
    "&Контекстное меню привязки"
    "&Object Snap Cursor Menu"
    )

[Елпанов Евгений]

Сообщение от Pilot Acad 2005 eng. У меня выскакивет вот это: [ATTACH]1160562037.jpg[/ATTACH] Похоже, это не то что нужно.

Спасибо за помощь!
Попробуйте пожалуйста такой вариант:

Код:

[Выделить все]

(defun c:test (/ d lst)
  ; (c:test)
  (princ "\nPress the right mouse button")
  (setq lst (reverse
              (menu-index
                ((lambda (x) (list (1- (vla-get-count x)) x))
                  (vla-item
                    (vla-get-menus
                      (vla-item
                        (vla-get-menugroups
                          (vlax-get-acad-object)
                        ) ;_  vla-get-MenuGroups
                        "ACAD"
                      ) ;_  vla-item
                    ) ;_  vla-get-Menus
                    "&Object Snap Cursor Menu"
                  ) ;_  vla-item
                )
              ) ;_  menu-index
            ) ;_  reverse
  ) ;_  setq
  (while (or (= (car (setq d (grread t 5))) 5)
             (= (car d) 11)
             (= (car d) 12)
             (= (car d) 25) ; For old version AutoCad
         ) ;_  or
    (cond
      ((= (car d) 25) (menucmd "POP500=*")) ; For old version AutoCad
      ((equal d '(11 0)) (menucmd "POP500=*"))
      ((= (car d) 11) (alert (nth (- (cadr d) 500) lst)))
    ) ;_  cond
  ) ;_  while
  (princ)
) ;_  defun
(defun menu-index (l)
  (if (not (minusp (car l)))
    (cond
      ((= (vla-get-type (vla-item (cadr l) (car l))) 0)
       (cons
         (vla-get-macro (vla-item (cadr l) (car l)))
         (menu-index (cons (1- (car l)) (cdr l)))
       ) ;_  cons
      )
      ((= (vla-get-type (vla-item (cadr l) (car l))) 1)
       (menu-index (cons (1- (car l)) (cdr l)))
      )
      ((= (vla-get-type (vla-item (cadr l) (car l))) 2)
       (append
         (menu-index
           ((lambda (x) (list (1- (vla-get-count x)) x))
             (vla-get-submenu (vla-item (cadr l) (car l)))
           ) ;_  menu-index
         ) ;_  menu-index
         (menu-index (cons (1- (car l)) (cdr l)))
       ) ;_  append
      )
    ) ;_  cond
  ) ;_  if
) ;_  defun

[Pilot]

В выпадающем меню результат примерно тот же.

Еще заметил сообщение в КС:

Command: test Press the right mouse buttonno function definition: VLAX-GET-ACAD-OBJECT

Наверно эти vla-... мне нужно сперва как-то инициализировать?

[CB]

Pilot:

Код:

[Выделить все]

(defun c:test (/ d lst)
(vl-load-com) 
  ; (c:test)

Елпанов Евгений:
В 2002Eng работают оба варианта

[Pilot]

С загрузкой

Код:

[Выделить все]

(vl-load-com)

получил вот это:
[ATTACH]1160662902.jpg[/ATTACH]
Снова не то?

[CB]

Pilot:
А .mnu какое загружено - родное акадовское или собственное?

[Pilot]

Слегка модифицированная (в основном акселерэйшнс) копия Акадовского с именем acad.mnu но из другой папки.