Aller au contenu
Problème de lien d'inscription (résolu ?) ×

menus partiels liste des sous item

tyrese69_

Par tyrese69_
dans Visual LISP

 Partager

Messages recommandés

tyrese69_ Newbie

tyrese69_

Posté(e)
Posté(e)

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

Lien vers le commentaire
Partager sur d’autres sites
tyrese69_ Newbie

tyrese69_

Posté(e)
  • Auteur
Posté(e)

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

Next

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

End If

Next

If BitNewMenuTPS = True Then

Exit For

End If

End If

Next

If BitNewMenuTPS = True Then

Exit For

End If

End If

If BitNewMenuTPS = True Then

Exit For

End If

Next

' Dans le cas ou le menu n'a pas la bonne version , il est RECHARGE !

' 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

'

Lien vers le commentaire
Partager sur d’autres sites
  • 3 semaines après...
GEGEMATIC Community Regular

GEGEMATIC

Posté(e)
Posté(e)

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))
)

)

----------------------------------------------------------------------

Site: https://www.g-eaux.fr

Blog: http://g-eaux.over-blog.com

Lien vers le commentaire
Partager sur d’autres sites
  • 2 semaines après...
  • 3 semaines après...
GEGEMATIC Community Regular

GEGEMATIC

Posté(e)
Posté(e)

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))
 )

)

----------------------------------------------------------------------

Site: https://www.g-eaux.fr

Blog: http://g-eaux.over-blog.com

Lien vers le commentaire
Partager sur d’autres sites
  • 3 semaines après...
tyrese69_ Newbie

tyrese69_

Posté(e)
  • Auteur
Posté(e)

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 !")
)
)

Lien vers le commentaire
Partager sur d’autres sites
tyrese69_ Newbie

tyrese69_

Posté(e)
  • Auteur
Posté(e)

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))
 )

)

Lien vers le commentaire
Partager sur d’autres sites
tyrese69_ Newbie

tyrese69_

Posté(e)
  • Auteur
Posté(e)

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

)

)

Lien vers le commentaire
Partager sur d’autres sites
tyrese69_ Newbie

tyrese69_

Posté(e)
  • Auteur
Posté(e)

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

)

)

post-185-0-64393400-1336740052_thumb.png

Lien vers le commentaire
Partager sur d’autres sites
Patrick_35 Newbie

Patrick_35

Posté(e)
Posté(e)

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 ;)

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Lien vers le commentaire
Partager sur d’autres sites
tyrese69_ Newbie

tyrese69_

Posté(e)
  • Auteur
Posté(e)

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))
)
)

Lien vers le commentaire
Partager sur d’autres sites
  • 4 semaines après...
GEGEMATIC Community Regular

GEGEMATIC

Posté(e)
Posté(e)

 

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 !

----------------------------------------------------------------------

Site: https://www.g-eaux.fr

Blog: http://g-eaux.over-blog.com

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité