Création de groupe d\'objets

[CwaM]

Salut

ENcore un probleme niveau vba que je n'ai pas réussi à solutionner

 

Je crée dans une routine des inseres de bloc. Jusque la, aucun probleme.

 

Ensuite, je voudrais les stocker dans un groupe d'objet Acadgroup.

 

J'ai bien trouvé la méthode AppendItems, j'ai toujours énormément de problemes et je n'arrive a rien :(

 

Une bonne ame parmi les cadxpien(ne)s? ;)

[Patrick_35]

Salut

En vlisp, j'aurai pu t'aider, mais à défaut, voici ce que j'ai trouvé dans l'aide

 

@+

 

Sub Example_AppendItems()
   ' This example creates a group and several objects.
   ' It then appends the objects to the group.
   
   ' Create the new group
   Dim groupObj As AcadGroup
   Set groupObj = ThisDrawing.Groups.Add("TEST_GROUP")
           
   ' Create a Ray object in model space
   Dim rayObj As AcadRay
   Dim basePoint(0 To 2) As Double

   Dim SecondPoint(0 To 2) As Double
   basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0#
   SecondPoint(0) = 1#: SecondPoint(1) = 3#: SecondPoint(2) = 0#
   Set rayObj = ThisDrawing.ModelSpace.AddRay(basePoint, SecondPoint)
   
   ' Create a polyline object in model space
   Dim plineObj As AcadLWPolyline
   Dim points(0 To 5) As Double

   points(0) = 3: points(1) = 7
   points(2) = 9: points(3) = 2
   points(4) = 3: points(5) = 5
   Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
   plineObj.Closed = True

   ' Create a line object in model space
   Dim lineObj As AcadLine
   Dim startPoint(0 To 2) As Double
   Dim endPoint(0 To 2) As Double

   startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
   endPoint(0) = 2: endPoint(1) = 2: endPoint(2) = 0
   Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
   
   ' Create a circle object in model space
   Dim circObj As AcadCircle
   Dim centerPt(0 To 2) As Double
   Dim radius As Double
   centerPt(0) = 20: centerPt(1) = 30: centerPt(2) = 0

   radius = 3
   Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)

   ' Create an ellipse object in model space
   Dim ellObj As AcadEllipse
   Dim majAxis(0 To 2) As Double
   Dim center(0 To 2) As Double
   Dim radRatio As Double
   center(0) = 5#: center(1) = 5#: center(2) = 0#
   majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0#

   radRatio = 0.3
   Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)

   ZoomAll
   
   ' Iterate through the model space collection.
   ' Collect the objects found into an array of objects
   ' to be added to the group.
   ReDim appendObjs(0 To ThisDrawing.ModelSpace.count - 1) As AcadEntity
   Dim I As Integer
   For I = 0 To ThisDrawing.ModelSpace.count - 1

       Set appendObjs(I) = ThisDrawing.ModelSpace.Item(I)
   Next
   
   ' Add the array of objects to the group
   groupObj.AppendItems appendObjs
   
   ThisDrawing.Regen acActiveViewport
   
End Sub

[CwaM]

J'avais bien trouvé ( et donc la méthode appenditems)

 

ce que j'essaie de faire:

 

J'ai mongroupe lors de l'appel de la routine

 

'création d'un bloc

Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, NomBloc, 1#, 1#, 1#, 0)

 

'Ajout de celui ci dans mon groupe:

groupobj.AppendItems blockRefObj

 

-> "Réseau d'objets incorrects"

[Patrick_35]

Oui, mais tes objets sont bien intégré dans une collection ? comme dans l'exemple

 

  ReDim appendObjs(0 To ThisDrawing.ModelSpace.count - 1) As AcadEntityDim I As Integer
For I = 0 To ThisDrawing.ModelSpace.count - 1

Set appendObjs(I) = ThisDrawing.ModelSpace.Item(I)
Next

 

@+

[CwaM]

Meme en essayant le code de l'aide j'ai une erreur :(

 

Erreur d'éxécution

 

Existe dansle groupe

 

 

 

Sinon j'ai cur comprendre dans l'aide qu'on a pas forcément besoin d'une collection pour ajouter dans le groupe

[nazemrap]

Bonjour.

 

Si tu as exécuté le code, le groupe est créé avec les objets concernés.

Si tu exécutes à nouveau, les objets sont déjà présents dans le groupe.

Il faut donc supprimer le groupe avant de recommencer la commande, ou enlever les objets du groupe.

 

nazemrap

[CwaM]

Bien vu/Je suis un boulet

 

Chacun choisit sa version ;)

 

merci, sinon je bloque toujours sur mon histoire de "Réseau d'objets incorrects"

 

[Edité le 10/5/2006 par CwaM]