Outre les 15 contrôles standards ou intégrés, on peut ajouter des contrôles supplémentaires appelés contrôles ActiveX pour VB5 et qui sont contenus dans des fichiers portant l'extension .OCX.
Ces contrôles peuvent être trouvés gratuitement, achetés auprès d'éditeurs spécialisés ou créés par vos propres soins à l'aide de VB5 ou C++.
Pour l'exercice suivant, nous allons utiliser Common Dialog , le contrôle qui permet, entre autres, d'utiliser la boîte de dialogue standard de Microsoft pour sélectionner les fichiers (Voir ci-dessous).

Pour charger Common Dialog :

• Après avoir lancé l'éditeur VBA et inséré une feuille quelconque, ouvrez la fenêtre contrôles supplémentaires du menu Outils puis cochez sur le contrôle Microsoft Common Dialog Control, version 5.0 .
  Le nouveau contrôle s'installera automatiquement dans la Boîte à outils.
• Si vous n'avez pas ce contrôle dans la liste, vérifiez que vous avez bien le fichier comctl32.ocx dans le répertoire Windows\System.
• Si oui, le contrôle n'a pas été "enregistré" dans la base de registres Windows.
  Pour cela, il suffira de lancer, par exemple, la commande :

             regsvr32 comctl32.ocx
           

  Nota : Si vous récupérez ou achetez un nouveau contrôle, vous devrez l' enregistrer de la même façon.
• Si vous n'avez pas le fichier comctl32.ocx vous pouvez utiliser la méthode ShowSaveDialog de AcadUnsupp. Voir chapître correspondant.
  

• Contrairement à la méthode WBlock de VBA, vous allez pouvoir indiquer le point d'insertion du bloc comme pour la version AutoLISP.
• Le vrai plus c'est qu'une option vous permettra de mettre le bloc sur le calque 0 avec les entités à la couleur "DuCalque". En effet, comme vous êtes expert en AutoCAD, vous savez bien que pour que le bloc que vous insérez prenne la couleur du calque courant, il faut qu'il ait été construit sur le calque 0 (zéro).

• On conserve le nom UserForm1
• Modifier la propriété Caption par WBloc+

• Option Explicit oblige à déclarer les variables, ce qui permet de réduire les conséquences des fautes de frappe.
• Public : les valeurs de ces variables sont utilisées dans plusieurs procédures.
• La pocédure WBlocPlus sert à lancer le programme.
  A noter : WBloc+ est écrit en toutes lettres, VBA n"acceptant pas le signe + dans le nom de la procédure.

    Option Explicit
    'Initialisation des variables
    Public ObjSelect As Object         ' Nom de la variable objet Sélection des objets
    Public DblPtBase(0 To 2) As Double ' Point de Base du bloc en tableau
    Public NbreSelect As Integer       ' Nombre d'objets sélrctionnés

  Public Sub WblocPlus()
    On Error Resume Next
    UserForm1.Show
  End Sub

• Déclaration des coordonnées par défaut (0,0,0) du point de base en valeurs numériques.
• Déclaration du nom et répertoire par défaut du bloc. A personnaliser !

Private Sub UserForm_Initialize()
    VarPtBase = Array(0#, 0#, 0#)
    ' Nom et répertoire par défaut du WBloc :
    TxtNomBloc.Text = "C:\AcadR14\BibBloc\test01.dwg"
End Sub

• Obtention du point de base du biloc par la méthode GetPoint
• Les valeurs sont affichées dans les boîtes de texte

Private Sub cmdGetPoint_Click()
    ' Procédure du choix du point de base du bloc
    ' on commence par cacher la feuille
    UserForm1.Hide
    VarPtBase = ThisDrawing.Utility.GetPoint(, "Point de base du bloc : ")
    ' Les valeurs sont affichées dans les boîtes de texte
    txtX.Text = VarPtBase(0)
    txtY.Text = VarPtBase(1)
    txtZ.Text = VarPtBase(2)
    ' On peut réafficher la feuille
    UserForm1.Show

End Sub

• On transforme la chaîne tapée directement dans la boîte de texte en valeur numérique

Private Sub txtX_Change()
    ' Procédure si écriture directe dans la Boite de texte
    ' transformation de la chaîne en valeur numérique
    VarPtBase(0) = Val(txtX.Value)
End Sub

Private Sub txtY_Change()
    VarPtBase(1) = Val(txtY.Value)
End Sub
 
Private Sub txtZ_Change()
    VarPtBase(2) = Val(txtZ.Value)
End Sub

• On commence par vérifier si le jeu de sélection est vide
  En effet, la méthode utlisée, SelectionSets.Add, crée un nouveau jeu.
• On affiche, sur la feuille, le nombre d'entités dans le jeu.
• Les entités sélectionnées sont "surlignées".

Private Sub cmdSelect_Click()
    ' Procédure de sélection des entités
    Dim txtNbreSelect, reponse As String
    ' s'il y a déjà eu une sélection de faite
    If NbreSelect > 0 Then
        ' 305 = 1 (boutons OK et Annuler) + 48 (Avertissement) + 256 (Annuler par défaut)
        reponse = MsgBox("Vous allez annuler la sélection en cours !", 305)
        If reponse <>  vbOK Then Exit Sub
    End If
    ' il faut cacher la feuille pour pouvoir sélectionner
    UserForm1.Hide
    ' création du jeu de sélection
    Set ObjSelect = ThisDrawing.SelectionSets.Add("Bloc01")
    'Selection des entites
    ObjSelect.SelectOnScreen
    ' comptage des entités
    NbreSelect = ObjSelect.count
    ' pour faire plus propre
    If NbreSelect < 2 Then
       txtNbreSelect = " élément sélectionné"
    Else
       txtNbreSelect = " éléments sélectionnés"
    End If
    ' affichage du nombre d'entités sélectionnées
    lblNombreSelect.Caption = ObjSelect.count & txtNbreSelect
    ' "surlignage" des objets sélectionnés
    ObjSelect.Highlight (True)
    UserForm1.Show
End Sub

• On commence par vérifier si le jeu de sélection n'est pas vide
  En effet, la méthode utlisée, AddItems, ajoute un nouveau jeu à un jeu existant.
• On crée un autre jeu de sélection.
• On transforme cette sélection en tableau dynamique par Redim.
• Ce tableau est ajouté au premier jeu.
• On affiche, sur la feuille, le nouveau total d'entités dans ce jeu.
• Les nouvelles entités sélectionnées sont "surlignées".

Private Sub cmdSelectPlus_Click()
    ' Procédure du bouton de commande Ajouter
    Dim ObjSelectModif As Object
    Dim msg  As String
    Dim Cpt1, i As Integer
    ' il faut qu'il y ait déjà une sélection d'effectuée
    If NbreSelect = 0 Then
        msg = "Vous devez d'abord créer un jeu par" + Chr(13) + Chr(10) + "le bouton  Saisir les Entités"
        ' 48 = message d'avertissement
        MsgBox msg, 48
        Exit Sub
    End If
    ' il faut cacher la feuille pour pouvoir sélectionner
    UserForm1.Hide
    ' création d'un nouveau jeu de sélection
    Set ObjSelectModif = ThisDrawing.SelectionSets.Add("ObjSelectModif")
     'Selection des entites
    ObjSelectModif.SelectOnScreen
    ' comptage des entités
    Cpt1 = ObjSelectModif.count
    ' transformation de la sélection en tableau dynamique
    ReDim TblSelectNew(0 To Cpt1 - 1) As Object
    For i = 0 To Cpt1 - 1
        Set TblSelectNew(i) = ObjSelectModif.Item(i)
    Next
    ' on ajoute la nouvelle sélection à la principale
    ObjSelect.AddItems TblSelectNew
    ' nouveau comptage
    NbreSelect = ObjSelect.count
    ' affichage du nombre d'entités sélectionnées
    lblNombreSelect.Caption = NbreSelect & " éléments sélectionnés"
    ' "surlignage" des nouveaux objets sélectionnés
    ObjSelectModif.Highlight (True)
    UserForm1.Show

End Sub

• Procédure pratiquement identique à Sub cmdSelectPlus_Click()

Private Sub cmdSelectMoins_Click()
    ' Procdure identique à cmdSelectPlus_Click()
    Dim ObjSelectModif As Object
    Dim msg  As String
    Dim Cpt1, i As Integer
    If NbreSelect = 0 Then
        msg = "Vous devez d'abord créer un jeu par" + Chr(13) + Chr(10) + "le bouton Saisir les Entités"
        MsgBox msg, 48
        Exit Sub
    End If
    UserForm1.Hide
    Set ObjSelectModif = ThisDrawing.SelectionSets.Add("ObjSelectModif")
    ObjSelectModif.SelectOnScreen
    Cpt1 = ObjSelectModif.count
    ReDim TblSelectNew(0 To Cpt1 - 1) As Object
    For i = 0 To Cpt1 - 1
        Set TblSelectNew(i) = ObjSelectModif.Item(i)
    Next
    ' différence avec cmdSelectPlus_Click() : remove au lieu de Add
    ObjSelect.RemoveItems TblSelectNew
    NbreSelect = ObjSelect.count
    lblNombreSelect.Caption = NbreSelect & " éléments sélectionnés"
    ' autre différence : suppression du surlignement des objets enlevés
    ObjSelectModif.Highlight (False)
    UserForm1.Show

End Sub

• Affichage de la fenêtre Common Dialog
• Le filtre permet de voir aussi tous les fichiers.
  Ajouté par souci pédagogique mais peut être supprimé.

Private Sub cmdNomFichier_Click()
    ' Procédure de changement du nom de bloc
    ' et affichage de la boîte Microsoft
    ErreurEcrit = False
    CommonDialog1.CancelError = True
    On Error GoTo ErrStop
    ' Flag 2 (Message si fichier existe) + Flag 4 (pas de case lecture seule)
    CommonDialog1.Flags = &H6&
    ' Choix des types de fichiers
    CommonDialog1.Filter = "Dessin (*.dwg)|*.dwg|Tous Fichiers (*.*)|*.*|"
    ' Filtre par défaut : Fichiers .dwg
    CommonDialog1.FilterIndex = 1
    ' Titre de la boîte
    CommonDialog1.DialogTitle = "Créer un fichier bloc"
    ' Méthode utilisée
    CommonDialog1.ShowSave
    ' Récupération du nom et répertoire du fichier à créer
    TxtNomBloc.Text = CommonDialog1.FileName
Exit Sub
ErrStop:
    MsgBox "Une erreur s'est produite !"
Exit Sub

End Sub

• La méthode WBlock enregistre le bloc avec comme point d'insertion le point de base du dessin.
• On va donc copier les entités de la sélection et les déplacer avec comme 1er point le point d'insertion désiré et comme point de déplacement le point de base du dessin.
  
• Si l'option Calque 0 est demandée, les entités copiées seront placées sur le calque zéro avec la couleur duCalque
• Pour les copies et modification d'entités, on doit transformer la sélection du type variant en tableau dynamique.
• Une fois le bloc créé, il ne reste plus qu'à effacer les entités copiées et supprimer le surlignement de la sélection.
• On peut ajouter en dernière ligne "Unload Me" pour sortir après chaque création.

Private Sub cmdOK_Click()
    ' Procédure finale sur bouton accepter
    Dim Cpt1, i As Integer          ' compteurs
    Dim ObjSelectDepl As Object     ' Sélection copiée et déplacée
    Dim OldInsbase As Variant       ' Point de base du dessin en cours
    Dim sysVarName As String
     
    sysVarName = "INSBASE"
    ' on récupère le point de base du dessin en cours
    OldInsbase = ThisDrawing.GetVariable(sysVarName)

    Cpt1 = ObjSelect.count
    ' on transforme la sélection en tableau dynamique
    ReDim TblSelectDepl(0 To Cpt1 - 1) As Object
      For i = 0 To Cpt1 - 1
        ' on copie chaque objet de la sélection
        Set TblSelectDepl(i) = ObjSelect.Item(i).Copy
        ' on déplace l'objet vers le point de base du plan
        TblSelectDepl(i).Move VarPtBase, OldInsbase
        ' Si on veut déplacer sur le calque 0,
        If chkPlan0.Value = True Then
             ' met l'objet sur le calque 0
             TblSelectDepl(i).Layer = "0"
             ' met la couleur de l'objet à "ducalque"
             TblSelectDepl(i).Color = acByLayer
        End If
      Next
    ' Création d'une nouvelle sélection
    Set ObjSelectDepl = ThisDrawing.SelectionSets.Add("Bloc02")
    ' on y met les objets déplacés
    ObjSelectDepl.AddItems TblSelectDepl
    ' création du WBloc
    ThisDrawing.Wblock TxtNomBloc.Text, ObjSelectDepl
    For i = 0 To Cpt1 - 1
        ' suppression des objets déplacés
        ObjSelectDepl(i).Erase
    Next
    ' ouf tout est fini, on le dit !
    If Dir$(TxtNomBloc.Text) = "" Then
       MsgBox "ATTENTION : Le bloc " & TxtNomBloc.Text & " n'a pas été créé !"
        Else
        MsgBox "Le bloc " & TxtNomBloc.Text & " a été créé avec succès !"
    End If
    ' on supprime le "surlignement" des objets sélectionnés
    ObjSelect.Highlight (False)
    ' mise à jour du dessin
    ObjSelect.Update
End Sub

• Quand on clique sur Annuler, il ne reste plus qu'à supprimer le surlignement de la sélection.

Private Sub cmdExit_Click()
    ' Procédure du bouton Annuler
    ' on supprime la "surbrillance" des objets sélectionnés
    ObjSelect.Highlight (False)
    Unload Me
End Sub

• le projet WBlocPlus.dvb
• le fichier acad.lsp
• le menu BiRaRR.mns
• les 2 icônes BMP