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

Boucler sur calques [Résolu] [VBA AutoCAD] - VB/VBA/VBS - Programmation

Marsh Posté le 15-11-2011 à 14:36:27    

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 :
  1. Private Sub CommandButton1_Click()
  3. '*****************************'
  4. '* Déclaration des variables *'
  5. '*****************************'
  7. Dim MyLayer As AcadLayer
  8. Dim MyBlock As AcadBlock
  9. Dim i As Integer
  10. Dim Message1 As String
  11. Dim Message2 As String
  12. Dim MyTab() As String
  14. 'Boucler sur les calques du dessin courant'
  15. For Each MyLayer In ThisDrawing.Layers
  16.     Message1 = Message1 & MyLayer.Name & vbLf
  17. Next MyLayer
  19. MsgBox Message1, , "Liste des calques courants"
  21. 'Boucler sur les calques des XREF du dessin courant'
  22. For Each MyBlock In ThisDrawing.Blocks
  23.     If MyBlock.IsXRef Then
  24.         ReDim MyTab(MyBlock.XRefDatabase.Blocks.Count)
  25.         For i = 0 To MyBlock.XRefDatabase.Blocks.Count - 1
  26.             MyTab(i) = MyBlock.XRefDatabase.Layers.Item(i).Name
  27.             Message2 = Message2 & MyTab(i) & vbLf
  28.         Next i
  29.     End If
  30. Next MyBlock
  32. MsgBox Message2, , "Liste des calques des XREF du dessin courant"
  34. End Sub


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


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

Marsh Posté le 15-11-2011 à 14:36:27   

Reply

Marsh Posté le 23-11-2011 à 15:15:22    

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

Code :
  1. Private Sub CommandButton1_Click()
  3. '*****************************'
  4. '* Déclaration des variables *'
  5. '*****************************'
  7. Dim MyBlock As AcadBlock
  8. Dim MyTab() As String
  9. Dim i As Integer
  10. Dim MyLayer As AcadLayer
  11. Dim TempLayer As String
  12. Dim Message As String
  14. 'Boucler et stocker les calques des XREF du dessin courant'
  15. For Each MyBlock In ThisDrawing.Blocks
  16.     If MyBlock.IsXRef Then
  17.         ReDim MyTab(MyBlock.XRefDatabase.Blocks.Count)
  18.         For i = 1 To MyBlock.XRefDatabase.Blocks.Count - 1
  19.             MyTab(i) = MyBlock.XRefDatabase.Layers.Item(i).Name
  20.         Next i
  21.     End If
  22. Next MyBlock
  24. 'Boucler et comparer les calques à ceux des XREF du dessin courant'
  25. For Each MyLayer In ThisDrawing.Layers
  26.     For i = 0 To UBound(MyTab())
  27.         If MyLayer.Name = MyTab(i) Then
  28.             TempLayer = ""
  29.             Exit For
  30.         Else
  31.             TempLayer = MyLayer.Name
  32.         End If
  33.     Next i
  34.    
  35.     If Not TempLayer = "" Then
  36.         Message = Message & TempLayer & vbLf
  37.     End If
  38.        
  39. Next MyLayer
  40.  
  41. MsgBox Message
  43. End Sub

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed