menus partiels liste des sous item

tyrese69_ · le 28 février 2012

Bonjour à tous,

J'ai un petit problème !

J'ai un menu partiel "TPS" par exemple qui comporte des sous menus de niveau 1, 2 et 3 !

Comment avoir la liste des item de niveau 1 ?

Et comment avoir la liste des item de l'item 1-2 par exemple ?

C'est pour vérifier si le texte de cet item est bien à la valeur "TPS1-2" par exemple

-0----1----2

TPS

----TPS0

----TPS1

---------TPS1-1

---------TPS1-2

Pas de problèmes pour réaliser cette fonction en VBA, mais comment faire avec les vla et vlax ?

daniel OLIVES

tyrese69_ · le 28 février 2012

Voici la m^me routine en VBA que je souhaite transposer en Vlisp :

Sub NewMenuTPS()

Dim objMenuGroups As AcadMenuGroups

Dim objMenuPop As AcadPopupMenu

Dim objMenu As AcadMenuGroup

Dim CommandLisp As String

Dim NomMenu As String

Dim NomMenuCui As String

Dim NomMenuMnr As String

Dim i As Integer

Dim j As Integer

Dim k As Integer

Dim menuGrp00 As String

Dim menuSsGrp00 As String

Dim BitNewMenuTPS As Boolean

Dim currMenuGroup As AcadMenuGroup

Dim currssMenuGroup As AcadMenuGroup

Dim Index As Integer

Index = 1

Set objMenuGroups = ThisDrawing.Application.MenuGroups

For Each objMenu In ThisDrawing.Application.MenuGroups

' Test des menus de la barre principale

If objMenu.name = "TPS" Then

' Test des menus de la barre principale

Set currMenuGroup = ThisDrawing.Application.MenuGroups.item(Index - 1)

For i = 0 To objMenu.Menus.Count - 1

If objMenu.Menus.item(i).name = "TPS" Then

' Parcours les items du menu "TPS"

For j = 0 To objMenu.Menus.item(i).Count - 1

menuGrp00 = currMenuGroup.Menus.item(i).item(j).Label

' Test des item des menus TPS de 1er rang

If left(menuGrp00, 11) = "B- à propos" Then

'---------------------------------------------------

' Parcours les items du sous-menu "B- à propos"

For k = 0 To objMenu.Menus.item(i).item(j).SubMenu.Count - 1

menuSsGrp00 = currMenuGroup.Menus.item(i).item(j).SubMenu.item(k).Caption

' Test des item du sous-menus "B- à propos" de 2eme rang

' Afin de vérifier la version et la date

If menuSsGrp00 = VersionMenuTPS Then

BitNewMenuTPS = True

Exit For

End If

Exit For

End If

Exit For

End If

If BitNewMenuTPS = True Then

Exit For

End If

' Il faut faire ATTENTION à bien mettre à jour la version dans TPS.mnu en cas de modification

' ainsi le rechargement est automatique !

If BitNewMenuTPS = 0 Then

MenuReloadTPS

End If

End Sub

'

GEGEMATIC · le 20 mars 2012

salut,

j'ai une commande qui devrait peut être t'aider:

Je pense l'avoir fait pour créer des entrées de menu conetxtuel, mais elle affiche ce dont tu as besoin ...

;****************************************************************************
;§/menu/programme de test pour visualiser l'arborescence des menus telle qu'elle est parcourue/none
(defun c:test_menu_tree ( / ok i j acadObject AcadMenuGroup NbMenuGroup currMenuGroup currMenuGroupMenus scMenu AlreadyExist)
(vl-Load-Com)
(setq acadObject (vlax-get-acad-object))
(setq AcadMenuGroup (vla-get-MenuGroups acadObject))
(prompt "\nNombre de menugroup")
(print (setq NbMenuGroup (vlax-get-property AcadMenuGroup 'Count)))

(setq j 0)

(while (and (< j NbMenuGroup) (not ok))
(setq currMenuGroup (vlax-invoke-method AcadMenuGroup 'Item j ))
(print (vlax-get-property currMenuGroup 'name))
(setq currMenuGroupMenus (vla-get-Menus currMenuGroup))
(prompt "\nNombre de scMenu : ")
(print (setq nb (vlax-get-property currMenuGroupMenus 'Count)))
;;parcours les menus pour trouver celui qui est contextuel
(setq i 0)
(while (and (< i nb) (not ok))
(setq scMenu (vlax-invoke-method currMenuGroupMenus 'Item i ))
(print (vlax-get-property scMenu 'name))
(if (= ':VLAX-TRUE (vlax-get-property scMenu 'ShortcutMenu))
 (progn
  (prompt "\Un contextuel trouvé:")
  (vlax-dump-object scMenu)
 )
;(setq ok T )
)
(setq i (+ 1 i))
)
(setq j (+ 1 j))
)

)

tyrese69_ · le 4 avril 2012

Bonjour Gegematic

Un grand merci pour ton aide !

Daniel OLIVES (désolé pour le retard trop de boulot!)

tyrese69_ · le 4 avril 2012

Re bonjour,

Cette commande parcours bien le menu principal, mais est il possible de parcourir un des sous menu ?

Daniel OLIVES

GEGEMATIC · le 25 avril 2012

Salut, ben tu vois, j'avais besoin de comprendre une bonne fois cette arbordescence compliquées pour pouvoir comprendre comment c'est foutu:

la fonction ci dessous déroule les menus, et donc le programme peut servir de squelette pour parcourir cette arborescence, pour y faire ce quel l'on veut ...

;****************************************************************************
;§/menu/programme de test pour visualiser l'arborescence des menus telle qu'elle est parcourue/none
(defun c:test_menu_tree	(/		ok	       i
		 j		acadObject     AcadMenuGroup
		 NbMenuGroup	currMenuGroup
		 currMenuGroupMenus	       scMenu
		 
		)
 (vl-Load-Com)
 (setq acadObject (vlax-get-acad-object))
 (setq MenuGroups (vla-get-MenuGroups acadObject))
 (prompt "\nNombre de menugroup ")
 (print
   (setq NbMenuGroup (vlax-get-property MenuGroups 'Count))
 )

 (setq j 0)

 (while (< j NbMenuGroup)
   (setq MenuGroupe (vlax-invoke-method MenuGroups 'Item j))
   (print (vlax-get-property MenuGroupe 'name))
   (setq MenuCollection (vla-get-Menus MenuGroupe))
   (prompt "\n   Nombre de sous Menu : ")
   (princ
     (setq nbScmenu (vlax-get-property MenuCollection 'Count))
   )
   ;;parcours les scmenus 
   (setq i 0)
   (while (< i nbScmenu)
     (setq scMenu (vlax-invoke-method MenuCollection 'Item i))
     (setq tmp scmenu)
     (if (vlax-property-available-p scMenu 'name)
(prompt
  (strcat "\n       " (vlax-get-property scMenu 'name))
)
     )
     (if (vlax-property-available-p scMenu 'label)
(prompt
  (strcat "\n       " (vlax-get-property scMenu 'label))
)
     )

     (prompt "\n                 Nombre de Menuitems ")
     (princ (setq NbMenuitems (vla-get-count scMenu)))
     ;;parcours les menuitems 
     (setq k 0)
     (while (< k NbMenuitems)
(setq MenuItem (vlax-invoke-method scMenu 'Item k))
(if (vlax-property-available-p MenuItem 'name)
  (prompt
    (strcat "\n                 " (vlax-get-property MenuItem 'name))
  )
)
(if (vlax-property-available-p MenuItem 'label)
  (prompt (strcat "\n                 "
		  (vlax-get-property MenuItem 'label)
	  )
  )
)

(setq k (+ 1 k))
     )

     (setq i (+ 1 i))
   )
   (setq j (+ 1 j))
 )

)

tyrese69_ · le 10 mai 2012

Bonjour GEGEMATIC

J'ai modifié ton code afin que les intitulés soient copiés dans un fichier txt, car la console n'est pas assez grande pour contenir l'ensemble des informations !

Encore merci je fouille un peut plus pour créer la fonction que je souhaite obtenir !

Vérifier si le menu charger contient le bon intitulé, sinon le menu est rechargé à la volée !

;****************************************************************************
;§/menu/programme de test pour visualiser l'arborescence des menus telle qu'elle est parcourue/none
(defun c:Tmenu (/              ok             i
                        j              acadObject     AcadMenuGroup
                        NbMenuGroup    currMenuGroup
                        currMenuGroupMenus            scMenu
                        
                       )
 (vl-Load-Com)
 (setq acadObject (vlax-get-acad-object))
 (setq MenuGroups (vla-get-MenuGroups acadObject))


 (setq j 0)
(if (setq f (open "C:\\Temp\\Liste_menu_item.txt" "w"))
	(progn
	  (setq NbMenuGroup (vlax-get-property MenuGroups 'Count))
	  (write-line (strcat "(Nombre de menugroup " (itoa NbMenuGroup) ")") f)
	  (while (< j NbMenuGroup)
		(setq MenuGroupe (vlax-invoke-method MenuGroups 'Item j))
		(write-line  (vlax-get-property MenuGroupe 'name)  f)
		(setq MenuCollection (vla-get-Menus MenuGroupe))
		
		(setq nbScmenu (vlax-get-property MenuCollection 'Count))
		(write-line (strcat "  (Nombre de sous Menu : " (itoa nbScmenu) ")") f)
		;;parcours les scmenus 
		(setq i 0)
		(while (< i nbScmenu)
		  (setq scMenu (vlax-invoke-method MenuCollection 'Item i))
		  (setq tmp scmenu)
		  (if (vlax-property-available-p scMenu 'name)
			(write-line (strcat "       " (vlax-get-property scMenu 'name)) f)
		  )
		  (if (vlax-property-available-p scMenu 'label)
			(write-line  (strcat "       " (vlax-get-property scMenu 'label)) f)
		  )
		  (setq NbMenuitems (vla-get-count scMenu))
		  (write-line (strcat "         (Nombre de Menuitems " (itoa NbMenuitems) ")") f)
		  ;;parcours les menuitems 
		  (setq k 0)
		  (while (< k NbMenuitems)
			(setq MenuItem (vlax-invoke-method scMenu 'Item k))
			(if (vlax-property-available-p MenuItem 'name)
			  (write-line (strcat "                 " (vlax-get-property MenuItem 'name)) f)
			)
			(if (vlax-property-available-p MenuItem 'label)
			  (write-line (strcat "                 " (vlax-get-property MenuItem 'label)) f)
			)

			(setq k (+ 1 k))
		  )

		  (setq i (+ 1 i))
		)
		(setq j (+ 1 j))
	  )
	  (close f)
	)
	(princ "\n Erreur - Fichier déjà ouvert !")
)
)

tyrese69_ · le 10 mai 2012

Bonsoir,

Comment descendre un niveau de PLUS ?

Afin de parcourir les sous item d'un item particulier ?

Daniel OLIVES

Salut, ben tu vois, j'avais besoin de comprendre une bonne fois cette arbordescence compliquées pour pouvoir comprendre comment c'est foutu:

la fonction ci dessous déroule les menus, et donc le programme peut servir de squelette pour parcourir cette arborescence, pour y faire ce quel l'on veut ...

;****************************************************************************
;§/menu/programme de test pour visualiser l'arborescence des menus telle qu'elle est parcourue/none
(defun c:test_menu_tree	(/		ok	       i
		 j		acadObject     AcadMenuGroup
		 NbMenuGroup	currMenuGroup
		 currMenuGroupMenus	       scMenu
		 
		)
 (vl-Load-Com)
 (setq acadObject (vlax-get-acad-object))
 (setq MenuGroups (vla-get-MenuGroups acadObject))
 (prompt "\nNombre de menugroup ")
 (print
   (setq NbMenuGroup (vlax-get-property MenuGroups 'Count))
 )

 (setq j 0)

 (while (< j NbMenuGroup)
   (setq MenuGroupe (vlax-invoke-method MenuGroups 'Item j))
   (print (vlax-get-property MenuGroupe 'name))
   (setq MenuCollection (vla-get-Menus MenuGroupe))
   (prompt "\n   Nombre de sous Menu : ")
   (princ
     (setq nbScmenu (vlax-get-property MenuCollection 'Count))
   )
   ;;parcours les scmenus 
   (setq i 0)
   (while (< i nbScmenu)
     (setq scMenu (vlax-invoke-method MenuCollection 'Item i))
     (setq tmp scmenu)
     (if (vlax-property-available-p scMenu 'name)
(prompt
  (strcat "\n       " (vlax-get-property scMenu 'name))
)
     )
     (if (vlax-property-available-p scMenu 'label)
(prompt
  (strcat "\n       " (vlax-get-property scMenu 'label))
)
     )

     (prompt "\n                 Nombre de Menuitems ")
     (princ (setq NbMenuitems (vla-get-count scMenu)))
     ;;parcours les menuitems 
     (setq k 0)
     (while (< k NbMenuitems)
(setq MenuItem (vlax-invoke-method scMenu 'Item k))
(if (vlax-property-available-p MenuItem 'name)
  (prompt
    (strcat "\n                 " (vlax-get-property MenuItem 'name))
  )
)
(if (vlax-property-available-p MenuItem 'label)
  (prompt (strcat "\n                 "
		  (vlax-get-property MenuItem 'label)
	  )
  )
)

(setq k (+ 1 k))
     )

     (setq i (+ 1 i))
   )
   (setq j (+ 1 j))
 )

)

tyrese69_ · le 11 mai 2012

Bonsoir,

Comment descendre un niveau de PLUS ?

Afin de parcourir les sous item d'un item particulier ?

Daniel OLIVES

Bonjour,

J'ai trouvé la solution par la voie directe sans aucuns contrôles !

Mon menu possède "20" item et je cherche à lire le label du "1er" du sous menu !

(setq LabelSubMenu

(vlax-get-property

(vla-item

(vla-get-submenu

(vlax-invoke-method

(vla-item

(vla-get-Menus

(vla-item

(vla-get-MenuGroups

(vlax-get-acad-object)

)

0

)

0

)

'Item

20

)

0

)

'label

)

tyrese69_ · le 11 mai 2012

Bonjour,

J'ai trouvé la solution par la voie directe sans aucuns contrôles !

Mon menu possède "20" item et je cherche à lire le label du "1er" du sous menu !

(setq LabelSubMenu
(vlax-get-property
(vla-item
(vla-get-submenu
(vlax-invoke-method
(vla-item
(vla-get-Menus
(vla-item
(vla-get-MenuGroups
(vlax-get-acad-object)
)
0
)
)
0
)
'Item
20
)
)
0
)
'label
)
)

Patrick_35 · le 11 mai 2012

Salut

Un exemple pour regarder de sous-menu "Utilitaires de dessin" du menu "Fichier" appartenant au Menu "ACAD"

(vlax-for ele
 (vla-get-submenu
   (vla-item
     (vla-item
(vla-get-Menus
  (vla-item
    (vla-get-MenuGroups
      (vlax-get-acad-object)
    )
    "ACAD"
  )
)
"&Fichier"
     )
     25
   )
 )
 (terpri)
 (princ (vla-get-label ele))
)

@+

ps : une petite récursive pour les sous-menus serait pas mal ;)

tyrese69_ · le 11 mai 2012

Bonsoir,

Merci à tous, voici le résultat !

(defun c:Tmenu (/              ok             i
                        j              acadObject     AcadMenuGroup
                        NbMenuGroup    currMenuGroup
                        currMenuGroupMenus            scMenu
                        
                       )
(vl-Load-Com)
(setq acadObject (vlax-get-acad-object))
(setq MenuGroups (vla-get-MenuGroups acadObject))

(setq j 0)
(setq NbMenuGroup (vlax-get-property MenuGroups 'Count))

(while (< j NbMenuGroup)
	;	(setq MenuGroupe (vlax-invoke-method MenuGroups 'Item 0))
	(setq MenuGroupe (vlax-invoke-method MenuGroups 'Item j))
	(princ (vlax-get-property MenuGroupe 'name))
	(setq MenuCollection (vla-get-Menus MenuGroupe))
	(setq nbScmenu (vlax-get-property MenuCollection 'Count))		
	
	(if  (= (vlax-get-property MenuGroupe 'name)  "TPS")
		(progn
			;;parcours les scmenus 
			(setq i 0)
			(while (< i nbScmenu)
				;	(setq scMenu (vlax-invoke-method MenuCollection 'Item 1))
				(setq scMenu (vlax-invoke-method MenuCollection 'Item i))
				;(if (vlax-property-available-p scMenu 'name)
				;	(alert (vlax-get-property scMenu 'name))
				;)
				;(if (vlax-property-available-p scMenu 'label)
				;	(alert (vlax-get-property scMenu 'label))
				;)

				;;parcours les menuitems 
				(setq NbMenuitems (vla-get-count scMenu))
				(setq k 0)
				(while (< k NbMenuitems)
					(setq MenuItem (vlax-invoke-method scMenu 'Item k))
					(if (vlax-property-available-p MenuItem 'name)
						;(if (= (vlax-get-property MenuItem 'name) "B- à propos")
							(alert (vlax-get-property MenuItem 'name))
						;)
					)
					(if (vlax-property-available-p MenuItem 'label)
					  	(if (=  (vlax-get-property MenuItem 'label) "B- à propos")
						  	(progn
								;	(alert (vlax-get-property MenuItem 'label))
							  	(setq LabelSubMenu (vlax-get-property (vla-item (vla-get-submenu MenuItem) 0) 'label))
								(if (= (substr LabelSubMenu (- (strlen LabelSubMenu) 9) 10) "2012-03-23") ;	"B-1- Version du menu TPS 2012-03-23"
									(alert (strcat "La date du fichier TPS.MNU est : " (substr LabelSubMenu (- (strlen LabelSubMenu) 9) 10)))	;	"B-1- Version du menu TPS 2012-03-23"
								)
							)
						)
					)
					(setq k (+ 1 k))
				)
				(setq i (+ 1 i))
			)
		)
	)
	(setq j (+ 1 j))
)
)

GEGEMATIC · le 5 juin 2012

ps : une petite récursive pour les sous-menus serait pas mal ;)

Salut Patrick,

C'est ce que j'ai pensé aussi, et j'ai perdu du temps pour rien, car en fait, de petites variations dans la structure d'imbrications que je n'avais pas anticipé font que ce n'est pas très adapté à la récursion.

finalement, j'en suis resté à un programme bien lourdingue !

Connexion

menus partiels liste des sous item

Messages recommandés

tyrese69_

tyrese69_

GEGEMATIC

tyrese69_

tyrese69_

GEGEMATIC

tyrese69_

tyrese69_

tyrese69_

tyrese69_

Patrick_35

tyrese69_

GEGEMATIC

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante