zoom objet automatique ?

[kisscool73]

bonjour qq1 pourrait il m'aider

j'ai une selection d'objet (dans mon cas des blocks)

puis je voudrais faire une boucle sur ma selection

zoomer sur chaque objet l'un apres l'autre

j'ai essayé

ThisDrawing.SendCommand ("_zoom" & vbCr & "_o")

mais apres je suis coincé

autocad me demande de selectionner un objet

comment passer un objet de ma selection a SendCommand

OU comment simuler que j'ai selectionner un objet

 

MERCI

[winfield]

Bonsoir,

T'es sûr de vouloir passer par SendCommand ?

[kisscool73]

non

toutes propositions sont les bienvenues

[winfield]

Je suis vraiment désolé, j'avais pas vu ta réponse.

 

 
Sub ZoomBloc()

   Dim ObjSelection As AcadSelectionSet
   Dim StrNomSelection As String
   
   StrNomSelection = "MaSelection"
   
   On Error Resume Next

   Set ObjSelection = ThisDrawing.SelectionSets(StrNomSelection)
   If Err <> 0 Then
       Err.Clear
       Set ObjSelection = ThisDrawing.SelectionSets.Add(StrNomSelection)
   End If
   ObjSelection.Clear
   
   Dim DataCodeDxf(0) As Variant
   Dim CodeDxf(0) As Integer
   
   CodeDxf(0) = 0: DataCodeDxf(0) = "INSERT"
   ObjSelection.SelectOnScreen CodeDxf, DataCodeDxf
   
   If ObjSelection.Count = 0 Then
       ObjSelection.Delete
       Exit Sub
   End If
   
   Dim Pt1 As Variant
   Dim Pt2 As Variant
   'ci-dessous, je crois que je fais un truc pas très catholique mais  'bon, ça reconnait lorsque tu appuyes sur la touche entrée pour 'passer au bloc suivant 
   For i = 0 To ObjSelection.Count - 1
       ObjSelection(i).GetBoundingBox Pt1, Pt2
       ZoomWindow Pt1, Pt2
       msg = ThisDrawing.Utility.GetKeyword(vbCr & "Bloc n°" & i & " Entrée :")
       If Err <> 0 Then
           Err.Clear
           Exit Sub
       End If
   Next

End Sub

A modifier selon tes besoins

 

Bonne continuation