trouver le nom du groupe

[PHILPHIL]

bonjour

 

je cherche le moyen de trouver a quel groupe appartient une entite

par le biais du LISP

 

pour crer un lisp permettant de rajouter ou enlever facilement des entites a un groupe

 

merci

 

phil

[Bred]

Salut,

je viens de faire ça, c'est pas parfait... à poffiner :

(il doit y avoir plus simple...)

 

(defun c:grob (/ GROUPES LST LSTF NG VLA-SEL X)
 ;;; listes (Groupes (objet1 objet2 ...))
 (setq groupes (vla-get-groups (vla-get-activedocument (vlax-get-acad-object)))
lstF nil)
 (vlax-for n groupes
   (setq ng (vla-get-name n)
  lst nil)
   (vlax-for i (vla-item groupes ng)
     (setq lst (cons i lst))
     )
   (setq lstF (append (list (cons ng lst)) lstF))
   )

 (setq vla-sel (vlax-ename->vla-object (car (entsel "\n Choix de l'objet :"))))
 (repeat (setq x (length lstF))
   (if (member vla-sel (nth (setq x (1- x)) lstF))
     (princ (strcat "\n Groupe : " (car (nth x lstF))))
   )
 )
 (princ)
 )

[PHILPHIL]

salut bred

 

plus simple ?? ca je peux pas te dire

je suis pas assez calé pour répondre a ca

 

il me manque toute la partie ( VL... VLAX.... VLR.... )

la traduction en francais de l'aide ACAD_ALR.chm

 

est en cour

 

puisque AUTODESK n'est pas foutu de le faire ( le sujet avait été evoqué ailleurs sur la traduction "robotisé" francaise de AUTOCAD)

 

en tous cas ca marche me reste plus qu'a comprendre ton LISP et l'integrer dans celui que je veux faire

 

je le metrais en ligne

 

merci

 

phil

[bseb67]

Salut Phil!

 

Cala rejoint un peu ce que tu veux, lors de mes débuts en lisp (il y a 6 mois)

j'ai fait ce petit truc qui permet de détruire un groupe en cliquant sur un des éléments

qui le compose

 ;-------------------------------------------;
; nom:   casse_groupe					    ;
;        casse (explose) un groupe en       ;
;	     sélectionnant un élément du groupe ;
; param: aucun								;
; date:  27/02/2007							;
; créateur: S. BLAES						;
;-------------------------------------------;
(defun C:DGR ()

; on demande à l'utilisateur de sélectionner un élément du groupe
(setq e (car (entsel)))

; on test si e est non nil
(if (/= e nil)
	(progn
		(setq l (entget e))
		; si l'élément appartient à un groupe, il existe alors le code ADN 102
		; et celui-ci contient "{ACAD_REACTORS"
		; on test alors son existence
		(if (and (/= (assoc 102 l) nil) (= (cdr (assoc 102 l)) "{ACAD_REACTORS"))
			(progn
				;(alert "oki")
				; maintenant il faut aller dans l'entité pointé par le code ADN 330
				; c'est en fait la déclaration du groupe
				(setq gp (cdr (assoc 330 l)))
				;(print gp)
				(setq lgp (entget gp))
				;(print lgp)
				
				; dans cette déclaration de groupe, on a la liste des éléments
				; qui le compose dans le code ADN 340
				; il faut donc retiré tous les codes 340
				; tant qu'il y a un code 340
				(while (/= (assoc 340 lgp) nil) 
					; on retire le code 340 est on stocke le résultat
					(setq lgp (vl-remove (cons 340 (cdr (assoc 340 lgp))) lgp))
					;(print lgp)
				) ; while
				
				; maintenant on fait un entmod de lgp
				; afin que les éléments du groupe soient séparés
				(entmod lgp)
				
				; on supprime la déclaration du groupe
				(entdel gp)
				(print "groupe cassé")
			) ; progn
			(alert "élément ne faisant pas partie d'un groupe")
		) ; if
	) ; progn
	(print "élément non sélectionné")
	
) ; if
(princ)
) ; C: DGR
(print "commande pour casser les groupes: DGR")
(C: DGR)

 

[Edité le 25/7/2007 par bseb67]

[Bred]

Re,

et l'integrer dans celui que je veux faire

Si tu veux en faire une routine :

 

(defun Get-Nom-Groupe (sel / GR GROUPES LST LSTF NG VLA-SEL X)
 ;;; listes (Groupes (objet1 objet2 ...))
 (setq groupes (vla-get-groups (vla-get-activedocument (vlax-get-acad-object)))
lstF nil)
 (vlax-for n groupes
   (setq ng (vla-get-name n)
  lst nil)
   (vlax-for i (vla-item groupes ng)
     (setq lst (cons i lst))
     )
   (setq lstF (append (list (cons ng lst)) lstF))
   )
 (setq vla-sel (vlax-ename->vla-object sel))
 (repeat (setq x (length lstF))
   (if (member vla-sel (nth (setq x (1- x)) lstF))
     (setq gr (car (nth x lstF)))
     )
   )
 gr
 )

 

=>

(setq nom-groupe (Get-Nom-Groupe (car (entsel "\n Choix de l'objet :"))))

[PHILPHIL]

j'avais fait un tit truc comme ca pour faire un peu de netoyage dans les groupss

 

      ; ----------------------------------------------
    ; RECHERCHE LES GROUPES VIDES ET LES DECOMPOSENT
    ; ----------------------------------------------

(defun c:klg (/ ent nom1 nomgroupe compt com objdict grpdict group1)
 (setvar "cmdecho" 1)
 (setvar "dimzin" 0)
 (setq group1 nil)
 (setq compt NIL)
 (setq com NIL)
 (while (= compt NIL) (setq compt (getREAL (strcat "\nENTRER LA VALEUR DE DEPART : "))))
 (while (= com NIL) (setq com (getREAL (strcat "\nENTRER LA VALEUR DE FIN : "))))
 (setq grve (- COM COMPT))
 (setq ent nil)
 (setq effa 1)
 (while (< compt com)
   (prompt (strcat "\rGROUPES A VERIFIER : "
	    (RTOS grve 2 0)
	    " 1ier PASSAGE : "
	    (rtos compt 2 0)
	    " EFFACER : "
	    (rtos EFFA 2 0)
	    " "
    )
   )
   (progn (setq n1 (strcat "*A" (rtos compt 2 0) ""))
   (setq objdict (namedobjdict))
   (setq grpdict (dictsearch objdict "ACAD_GROUP"))
   (setq nomgroupe2 (assoc 0 grpdict))
   (setq group1 (dictsearch (cdar grpdict) n1))
   (if (/= group1 nil)
     (deco)
   )
   )
   (setq compt (1+ compt))
 )
 (princ (strcat "\nLE PROGRAMME A EFFACER " (rtos EFFA 2 0) " GROUPES"))
 (setvar "dimzin" 8)
 (setvar "cmdecho" 1)
)

(defun deco ()
 (setq gr340 (assoc 340 group1))
 (if (= gr340 nil)
   (progn (entdel (handent (cdr (assoc 5 group1)))) (setq effa (1+ effa)))
 )
)

 

phil