sos svp!!

[sam2009]

:exclam: je m'excuse mais il ya personne qui m'a répondu alors j'ai refait le sujet pour redemander l'aide !

 

voilà je ne sais pas pourquoi mon programme ce plante :casstet: qand il arrive à ça : " Dim Entite As AcadBlockReference"

 

stp voilà le programme le but est de selectionner tout les attributs qui ce trouve dans le dessin courant et les mettre dans la variable "temp" pour les réutilisés après

 

merci infinnement pour votre aide si précieuse !

 

 

 

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

'Section 4. Sélection du dessin en cours

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

Dim EnTete As Boolean

Rangee = 1

EnTete = False

If selection_existe("TEMP") Then

Set Selection = ThisDrawing.SelectionSets("TEMP")

Selection.Clear

Else

Set Selection = ThisDrawing.SelectionSets.Add("TEMP")

End If

 

Selection.Select acSelectionSetAll, Codes, Valeurs

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

'Section 4. Extraction des attributs.

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

Dim Entite As AcadBlockReference

 

For Each Entite In Selection

Matrice = Entite.GetAttributes

If EnTete = False Then

For Compte = LBound(Matrice) To UBound(Matrice)

If StrComp(Matrice(Compte).EntityName, "AcDbAttribute", 1) = 0 Then

Feuille.Cells(Rangee, Compte + 1).Value = Matrice(Compte).TagString

End If

Next Compte

End If

Rangee = Rangee + 1

 

For Compte = LBound(Matrice) To UBound(Matrice)

Feuille.Cells(Rangee, Compte + 1).Value = Matrice(Compte).TextString

Next Compte

EnTete = True

 

Next

 

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

'Section 6. effacer la selection "TEMP"

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

 

Public Function selection_existe(strnom As String) As Boolean

Dim control As Boolean

control = False

On Error Resume Next

Set objselection = ThisDrawing.SelectionSets(strnom)

If Err Then

Err.Clear

Set objselection = ThisDrawing.SelectionSets.Add(strnom)

If Not Err Then control = True

Else

control = True

End If

selection_existe = control

End Function

 

[bazoul]

J'ai testé et ça ne plante pas a la ligne indiqué.

Quel version autocad as tu?

Tu veux récupérer tous les attribut dans un liste c'est bien sa?

 

 

PS: Evite de faire trois sujets sur la meme question ...

[sam2009]

merci pour ta réponse !

 

enfait j'ai la version 2004 d'autocad

oui je veux récupérer tous mes attributs dans une liste

 

merci encore pour l'interêt que tu as donné à mon problème !

 

 

nb: j'ai vraiment besoin de ce programme c'est trés urgent merci pour votre aide

[bazoul]

Alors:

' ---------------------------------------------------
'Section 4. Extraction des attributs.
' ---------------------------------------------------
Dim mEntite As AcadBlockReference
Dim listofatt() As AcadAttributeReference
Dim mMatrice As Variant

For Each mEntite In Selection

If mEntite.HasAttributes Then
Dim matt(1) As String
mMatrice = mEntite.GetAttributes
   For i = 0 To UBound(mMatrice) - 1
       ReDim Preserve listofatt(UBound(listofatt) + 1)
       Set listofatt(UBound(listofatt)) = mMatrice(i)
   Next i
End If
Next

 

Je te propose ce qui précède,le résultat est une liste de référence d'attribut.

En espérant que cela te contienne.

 

[Edité le 29/10/2009 par bazoul]