[VBA AutoCAD] Boucler sur calques [Résolu]

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : [VBA AutoCAD] Boucler sur calques [Résolu]

mmarle

Bonjour,

Je travaille actuellement sur une petite application sous AutoCAD 2011 (Hé oui! la dernière version prenant en charge le VBA, VB.NET pour les versions ultérieures).

Cela fait un petit moment que je bute sur un problème que voici:
Je souhaite boucler sur la collection de calques à l'exception de celle des références externes (XREF).

J'arrive à boucler sur tous les calques du dessin courant, faisant appel la collection Layers, mais celle-ci renvoie également les calques des XREF.
J'arrive aussi à boucler sur les calques des XREF, faisant appel à la collection Blocks et la méthode IsXref.

Ce que j'aimerais, c'est d'avoir la liste des calques sans les calques des XREF.

J'ai tenté de stocker dans une variable tableau la liste des noms de calques des XREF puis de la comparer à celle des noms de calques du dessin courant, mais là...c'est le drame!

Voici mon code:

Code :

Private Sub CommandButton1_Click()
'*****************************'
'* Déclaration des variables *'
'*****************************'
Dim MyLayer As AcadLayer
Dim MyBlock As AcadBlock
Dim i As Integer
Dim Message1 As String
Dim Message2 As String
Dim MyTab() As String
'Boucler sur les calques du dessin courant'
For Each MyLayer In ThisDrawing.Layers
Message1 = Message1 & MyLayer.Name & vbLf
Next MyLayer
MsgBox Message1, , "Liste des calques courants"
'Boucler sur les calques des XREF du dessin courant'
For Each MyBlock In ThisDrawing.Blocks
If MyBlock.IsXRef Then
ReDim MyTab(MyBlock.XRefDatabase.Blocks.Count)
For i = 0 To MyBlock.XRefDatabase.Blocks.Count - 1
MyTab(i) = MyBlock.XRefDatabase.Layers.Item(i).Name
Message2 = Message2 & MyTab(i) & vbLf
Next i
End If
Next MyBlock
MsgBox Message2, , "Liste des calques des XREF du dessin courant"
End Sub

Aidez-moi, s'il vous plaît! Merci.

Message édité par mmarle le 23-11-2011 à 15:16:58

Publicité

mmarle

Je viens de trouver la solution! Miracle, c'était tout con, comme bien souvent des fois.

Code :

Private Sub CommandButton1_Click()
'*****************************'
'* Déclaration des variables *'
'*****************************'
Dim MyBlock As AcadBlock
Dim MyTab() As String
Dim i As Integer
Dim MyLayer As AcadLayer
Dim TempLayer As String
Dim Message As String
'Boucler et stocker les calques des XREF du dessin courant'
For Each MyBlock In ThisDrawing.Blocks
If MyBlock.IsXRef Then
ReDim MyTab(MyBlock.XRefDatabase.Blocks.Count)
For i = 1 To MyBlock.XRefDatabase.Blocks.Count - 1
MyTab(i) = MyBlock.XRefDatabase.Layers.Item(i).Name
Next i
End If
Next MyBlock
'Boucler et comparer les calques à ceux des XREF du dessin courant'
For Each MyLayer In ThisDrawing.Layers
For i = 0 To UBound(MyTab())
If MyLayer.Name = MyTab(i) Then
TempLayer = ""
Exit For
Else
TempLayer = MyLayer.Name
End If
Next i
If Not TempLayer = "" Then
Message = Message & TempLayer & vbLf
End If
Next MyLayer
MsgBox Message
End Sub

FORUM HardWare.fr

Programmation

VB/VBA/VBS

[VBA AutoCAD] Boucler sur calques [Résolu]

Sujets relatifs
[VBA] Type utilisateur et objet	[VBA AutoCAD] Problème inter-application
[VBA Autocad] dessiner la symétrie d'un point par rapport à une ligne.	VBA Autocad Déplacement en spécifiant une coordonnée
VBA Tourner sur lui même du texte dans autocad	[VBA =>AUTOCAD] chemin du projet .dvb
[VBA] Importation de Coordonnées d'Autocad à Excel	VBA et autocad
piloter Autocad en VBA	VBA & AUTOCAD ?
Plus de sujets relatifs à : [VBA AutoCAD] Boucler sur calques [Résolu]

Page générée en 0.034 secondes