Problème de Nom de bloc (VBA)

[Bât-man]

Bonjour,

 

Je souhaiterais créer des bloc sur VBA avec une incrémentation de nom automatique ,ou créer des blocs anonymes, pour ne pas avoir de problème parce que le nom existe déjà.

 

Quelqu'un pourrait m'aider ?

:) merci d'avance

[winfield]

Slt

A ma connaissance, on ne peut pas créer de bloc anonyme en vba.

Mais bloc anonyme ou pas, tu veux incrémenter alors, le problème reste entier.

 

En espérant que ce bout de code t'aide :

 Sub Bloc_i()
   
   Dim ObjBloc As AcadBlock
   Dim StrBloc As String
   Dim Pt0(1) As Double
   Dim i As Integer
   Dim ii As Integer
   Dim Pt1(2) As Double
   Dim Pt2(2) As Double
   Dim ObjLigne As AcadLine
   
   Pt0(0) = 0: Pt0(1) = 0
   Pt1(0) = 0: Pt1(1) = 0
   Pt2(0) = 50: Pt2(1) = 45
   StrBloc = "MonBloc"
   
   On Error Resume Next
   
   For i = 0 To ThisDrawing.Blocks.Count
       Set ObjBloc = ThisDrawing.Blocks(StrBloc)
       If Err Then
           Err.Clear
           Set ObjBloc = ThisDrawing.Blocks.Add(Pt0, StrBloc)
           Exit For
       Else
           For ii = 0 To ThisDrawing.Blocks.Count
               Set ObjBloc = ThisDrawing.Blocks(StrBloc & "_" & ii)
               If Err Then
                   Err.Clear
                   Set ObjBloc = ThisDrawing.Blocks.Add(Pt0, StrBloc & "_" & ii)
                   Exit For
               End If
           Next
       End If
   Next
   
End Sub

Ici, le bloc est vide, il faut rajouter les entités nécessaires à ton bloc.

Bonne continuation

 

[sechanbask]

voilà comment je procède

Je tente de renommer le bloc, si j'ai une erreur, je la gère en entrant dans une boucle " Do... Loop Until Err.Number <> "-2145386405" ",. Dans cette boucle je renomme le bloc de manière incrémentielle et hop le tour est jouer.

 

Je te laisse le code qui est contenu dans mon nettoyeur (à tester si tu ne le connais pas encore, hop un peu de promotion !!). En espérant que cela puisse t'aider.

 

 

Function modifier_nom_bloc()

Dim objBlock As AcadBlock
Dim IntN As Integer
Dim intI As Integer
Dim intJ As Integer
Dim strNom_bloc_ini As String
Dim strDebut As String
Dim strPrefixe As String
Dim strPremiere_lettre As String

'si erreur aller dans la partie gestion :

On Error GoTo gestion

'Demande à l'utilisateur le nom pour le préfixe du bloc
strPrefixe = Nparametres.TB_nom_bloc.Text
If strPrefixe = "" Then

'ne rien faire
Else


'compter le nombre de lettre du préfixe
intJ = VBA.Len(strPrefixe)



   'faire une boucle dans la collection des blocs
   For Each objBlock In ThisDrawing.Blocks



'test pour savoir si le bloc est un Xref
If objBlock.IsXRef Then
'Debug.Print "objBlock.Name", objBlock.Name, "objBlock.IsXRef", objBlock.IsXRef

Else

   strNom_bloc_ini = objBlock.Name
   
       'si les 12 permiers caractères du nom du bloc commence par...
       Select Case VBA.Left(strNom_bloc_ini, 12)
       
       '"*model_space ou "*paperspace"
       Case "*Model_Space", "*Paper_Space"
       'ne rien faire ce ne sont pas des blocs
       
       'si non
       Case Else
       
       'récupérer le prefixe du bloc de la longueur du préfixe indiqué par l'utilisateur
       strDebut = VBA.Left(strNom_bloc_ini, intJ)
       
           'tester si le bloc possède déjà le préfixe
           If strDebut <> strPrefixe Then
           
           'si erreur lire la ligne suivante
           On Error Resume Next
           
           'Ajouter le préfixe au nom du bloc
           objBlock.Name = strPrefixe & strNom_bloc_ini
           
               'Si un bloc porte dejà ce nom bis
               If Err.Number = "-2145386405" Then
               
               'Effacement de l'enregistrement de l'erreur
               'Err.Clear
               
               'initialiser la variable pour le suffixe variable
               IntN = 0
               
                   'Faire ça jusqu'à ce que ...
                   Do
                   
                   'Effacement de l'enregistrement de l'erreur
                   Err.Clear
                   
                   IntN = IntN + 1
                   'Ajouter le préfixe au nom du bloc + un suffixe incrémentiel pour éviter l'erreur si un bloc porte le nom du nom + le préfixe + intN-1
                   objBlock.Name = strPrefixe & strNom_bloc_ini & "_" & IntN
                   
                   '...l'erreur enregistré sous "-2145386405" soit invalidée
                   Loop Until Err.Number <> "-2145386405"
               
               End If 'Si un bloc porte dejà ce nom bis

           Else
           'DP "ne rien faire"
           End If 'tester si le bloc possède déjà le préfixe
       
       
       End Select
   
End If
   Next objBlock

End If

Exit Function
gestion:

Debug.Print Err.Number, Err.Description

End Function

 

 

Bon courage

 

[Edité le 12/5/2009 par sechanbask]