Effacer des cotes dans des blocs

[micheld]

Bonjour à tous,

Et bonne année, par la même occasion. je cherche à effacer des cotations intégrés à des blocs dans des fichiers autocad 2006. J'ai le code suivant, qui à tendance à effacer n'importe quoi (sauf les côtes bien sûr):

 

 

Public Sub ModifCotBloc()

Dim objBlock As AcadBlock

Dim objEntity As AcadEntity

Dim i, j As Integer

 

On Error Resume Next

 

'Parcoure les définitions de blocs

For Each objBlock In ThisDrawing.Blocks

'Ne tient pas compte des blocs modelspace et paperspace

If Left(objBlock.Name, 1) <> "*" Then

'Parcoure les éléments du bloc

For i = 0 To objBlock.Count - 1

'Utilise que les éléments cotation contenus dans le bloc

If objBlock.Item(i).ObjectName = acDimRotated Then

'Supprime l'élément du bloc

objBlock.Item(i).Delete

End If

Next i

End If

Next objBlock

ThisDrawing.Regen acAllViewports

 

End Sub

 

 

Je précise que ce sont des côtes pivotées (apparement) qui sont contenus dans le dessin.

J'ajoute que l'aide AutoCAD me dit ceci:

 

"object.Delete

 

Object

 

All Drawing Objects, Block, Dictionary, DimStyle, Group, Hyperlink, Layer, LayerStateManager, Layout, Linetype, PlotConfiguration, PopupMenuItem, PViewport, RegisteredApplication, SelectionSet, TextStyle, Toolbar, ToolbarItem, UCS, View, Viewport, XRecord

The object or objects this method applies to.

 

Remarks

 

When you delete an object in a collection, all remaining items in the collection are reassigned a new index based on the current count. You should therefore avoid loops that delete an object while iterating through the collection. For example, the following VBA code will result in a runtime error:

 

For i = 0 To ThisDrawing.Groups.Count - 1

ThisDrawing.Groups.Item(i).Delete

Next I

 

Instead, use the following VBA code to delete all members in a collection:

 

for each obj in ThisDrawing.Groups

obj.Delete

next obj

 

You can also use the following VBA code to delete a single member of a collection:

 

ThisDrawing.Groups.item("group1").Delete

 

An error will result if you attempt to delete a collection object.

 

ToolbarItem: You can only add or remove toolbar items when the toolbar is visible.

 

AcadLayerStateManager: This object takes an argument, Name, which is a string representing the layer state to be deleted."

 

Quelle pourrait-être la solution?

 

Merci par avance pour vos réponses. Bonne journée

[nazemrap]

Bonjour,

 

Sous réserve, essaies avec cela:

 

If objBlock.Item(i).ObjectName = "AcDbRotatedDimension"

[micheld]

Merci nazemrap,

Ca fonctionne déjà beaucoup mieux :D

Il faut juste repasser la moulinette une deuxième fois pour éliminer toutes les côtes (c'est dû à la re-numérotation des items à l'intérieur du bloc, cf l'aide VBA déjà citée, je pense). Mais c'est déjà chouette comme ça.

 

Bonne journée et merci une fois de plus.