VBA Le B.A.-BA du VBA


Liste des trucs :       
Programmes testés pour le VBA d'AutoCAD version 14.01
Ces exemples ne sont pas conçus pour fonctionner tel quels en simple Visual Basic (VBx).
Dans la partie + Loin avec VBA & VB vous trouverez les exemples équivalents pour VB, quand celà est possible.
Pour tester ces programmes, procédez de la même manière que pour les Exemples de base.


-----

1 - Vérifier si un programme est déjà chargé

Comment faire pour vérifier si un programme VBA est déjà chargé avant d'exécuter la commande -vbarun dans un menu ?

Dans le chapître Boutonnière il est donné un exemple de programme de chargement automatique, en AutoLISP qui permet de lancer la routine en cliquant sur un bouton.
Voici comment modifier ce programme pour empêcher une tentative de rechargement qui réinitialiserait les variables.

On se sert de la variable UserS1 pour noter que le programme est déjà chargé.
Seules les variables User permettent de communiquer entre VBA et AutoLISP.
Attention, vérifiez auparavant que cette variable n'est pas utilisée par un autre programme.

 

  (defun oblong()
    (setq *filedia* (getvar "filedia"))
    (setvar "filedia" 0)    
    (if (command "-vbarun" "boutonniere")
      (princ)
      (if (= "1" (getvar "USERS1"))
          (princ)
          (progn 
            (command "vbaload" "d:\\acadr14\\vbamacro\\oblong.dvb")
            (setvar "USERS1" "1")
            (command "-vbarun" "boutonniere")
          )
       )
     )
     (setvar "filedia" *filedia*)
    (princ)
  )


2 - Nouveau dessin sans sauvegarde du dessin courant

Comment faire pour ouvrir un nouveau dessin sans sauvegarder le dessin en cours et sans afficher la boîte de dialogue correspondante ?

La variable système dbmod indique l'état de modification du dessin. Si cette variable est égale à 0 (zéro), celà indique que le dessin n'a pas été modifié, qu'il n'est pas nécessaire de sauvegarder et la boîte de dialogue 'Enregistrer les modifications ?' ne sera pas affichée.
Cette variable est déclarée en lecture seule et n'est pas modifiable en AutoLISP. En VBA ou VB on peut néammoins donner la valeur zéro à cette variable pour empêcher la venue de la boîte de dialogue.
Pour celà, deux possibilités :
  1. Utiliser la méthode SetDBmod de l'application AcadUnsupp.arx.
    Pour l'utilisation de AcadUnsupp.arx voir le chapitre Des Extensions pour AutoCAD ActiveX Automation
  2. Une seconde possibilité, expliquée ici, est d'utiliser une fonction exportée directement de acad.exe
    Merci à Denis Gagné qui à découvert cette fonction au nom plus que bizarre.
La 1ère partie, la déclaration, sera copiée dans (General) de Module1,
la seconde partie est le code de UserForm1.

 

' ****** 1ère  Partie : Déclaration dans Module1 
Public Declare Function SetDBMod Lib "acad.exe" Alias _
 "?acdbSetDbmod@@YAJPAVAcDbDatabase@@J@Z" (modified As Long) As Long
' fin 1ère partie

'*****************************************************************

' 2éme partie : Code de UserForm1
Private Sub CommandButton1_Click()
  On Error Resume Next
  SetDBMod 0
  ThisDrawing.Open("C:\Projet05\dessin06.dwg")
     
End Sub


3 - Résolution de l'écran

Comment faire pour connaître la résolution de l'écran ?

Le programme qui suit utilise la fonction API GetWindowRect pour obtenir les dimensions de l'écran - en réalité du bureau.
Pour préciser le handle du bureau on utilisera une autre fonction API, GetDesktopWindow.
La 1ère partie, les déclarations, doit être copiée dans (General) de Module1,
la seconde partie est le code de UserForm1.

 

' ****** 1ère  Partie : Déclarations dans Module1 
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
		lpRect As RECT) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long

Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
' fin 1ère partie

'*****************************************************************

' 2éme partie : Code de UserForm1
Private Sub CommandButton1_Click()
  Dim FenRect As RECT
  Dim Retour As Long
  
  Hwnd& = GetDesktopWindow()
  Retour = GetWindowRect(Hwnd&, FenRect)
  wLargeur = FenRect.Right
  wHauteur = FenRect.Bottom
  
  MsgBox "Résolution de l'écran : " & wLargeur & " * " & wHauteur
    
End Sub




4 - Dimensions de la fenêtre active

Comment faire pour connaître les dimensions (en pixel) de la fenêtre active ?

Programme pratiquement identique au précédent mais pour préciser le handle du bureau on utilisera une autre fonction API, GetActiveWindow. en lieu et place de GetDesktopWindow.
La 1ère partie, les déclarations, doit être copiée dans (General) de Module1,
la seconde partie est le code de UserForm1.

 

' ****** 1ère  Partie : Déclarations dans Module1 
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
		lpRect As RECT) As Long
Public Declare Function GetActiveWindow Lib "user32" () As Long

Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
' fin 1ère partie

'*****************************************************************

' 2éme partie : Code de UserForm1
Private Sub CommandButton1_Click()
  Dim FenRect As RECT
  Dim Retour As Long
  
  Hwnd& = GetActiveWindow()
  Retour = GetWindowRect(Hwnd&, FenRect)
  wLargeur = FenRect.Right
  wHauteur = FenRect.Bottom
  
  MsgBox "Dimension de la fenêtre active : " & wLargeur & " * " & wHauteur
    
End Sub


5 - Dimensions de la fenêtre AutoCAD

Comment faire pour connaître les dimensions (en pixel) de la fenêtre AutoCAD ?

Comme pour les deux programmes précédents on utilisera la fonction API GetWindowRect.
Pour préciser le handle de la fenêtre AutoCAD, il nous faudra utiliser la propriété AcadHwnd de la DLL ACVBEXT.
Pour l'utilisation de ACVBEXT voir le chapitre Des Extensions pour AutoCAD ActiveX Automation

La 1ère partie, les déclarations, doit être copiée dans (General) de Module1,
la seconde partie est le code de UserForm1.

 

' ****** 1ère  Partie : Déclarations dans Module1 
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
		lpRect As RECT) As Long
 
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
' fin 1ère partie

'*****************************************************************

' 2éme partie : Code de UserForm1
Private Sub CommandButton1_Click()
  Dim FenRect As RECT
  Dim Retour As Long
  
  Set objAcvb = ThisDrawing.Application.GetInterfaceObject _
		("ActiveXExtension.Application.1")
  hwnd& = objAcvb.AcadHwnd
  Retour = GetWindowRect(hwnd&, FenRect)
  wLargeur = FenRect.Right
  wHauteur = FenRect.Bottom
  
  MsgBox "Résolution de la fenêtre AutoCAD :  " & wLargeur & " * " & wHauteur
    
End Sub


6 - Périmètre et région - Un objet fermé

Comment faire pour connaître le périmètre d'une entité quelconque ?

Cette routine vous donnera le périmètre de toute entité, à condition qu'elle soit fermée (cercle, ellipse, polyligne fermée, etc.)
Le programme copie l'entité sélectionnée en région pour obtenir sa propriété perimeter.
Après affichage du périmètre, la région est supprimée.
L'entité choisie ne doit pas déjà être une région.
On utilise la fonction Format pour arrondir le résultat.
Voici le code de UserForm1.

 

Private Sub CommandButton1_Click()
  Dim Obj1 As Object
  Dim Pt1 As Variant
  Dim Entite(0) As Object
  Dim RegionSel As Variant
  Dim Resultat As Double
  
  UserForm1.Hide
  ThisDrawing.Utility.GetEntity Obj1, Pt1, "Sélectionnez un objet "
  ' on transforme Obj1 en tableau
  Set Entite(0) = Obj1
  On Error GoTo ErrorStop
  RegionSel = ThisDrawing.ModelSpace.AddRegion(Entite)
  Resultat = RegionSel(0).Perimeter
  ' format pour arrondir le résultat.
  MsgBox "Périmètre : " & Format(Resultat, "0.00")
  RegionSel(0).Erase
  Exit Sub
ErrorStop:
 MsgBox "Erreur dans la sélection de l'objet;" & _
         vbCrLf & "Ce doit être une entité fermée."
 Exit Sub

End Sub


7 - Périmètre et région par sélection multiple

Comment faire pour connaître le périmètre d'une zone fermée ?

Cette routine vous donnera le périmètre de toute zone, à condition qu'elle soit fermée. par des lignes, arcs, cercles, ellipses, polylignes, etc.
Le programme crée une (ou plusieurs) région(s) à partir des éléments sélectionnés pour obtenir sa propriété perimeter.
Attention, selon la sélection, il pourrait y avoir plusieurs régions de créées ; Il faudra dans ce cas modifier la routine car actuellement elle ne donne que le périmètre de la première région.
Après affichage du périmètre, cette région est supprimée.
On utilise la fonction Format pour arrondir le résultat.

 

Private Sub CommandButton1_Click()
   Dim Obj1 As Object
   Dim BaSelect As Variant
   Dim Pt1 As Variant
   Dim Entite(0) As Object
   Dim RegionSel As Variant
   Dim Resultat As Double
   Dim Cpt1, i As Integer
   ' on cache la feuille pour pouvoir sélectionner
   UserForm1.Hide
   Set BaSelect = ThisDrawing.SelectionSets.Add("BaVBa")
   Call BaSelect.SelectOnScreen
   ' on compte le nombre de sélections
   Cpt1 = BaSelect.Count
   ' on transforme le jeu de sélection en tableau
   ReDim TblSel(0 To Cpt1 - 1) As Object
   For i = 0 To Cpt1 - 1
     Set TblSel(i) = BaSelect.Item(i)
   Next
   On Error GoTo ErrorStop
   RegionSel = ThisDrawing.ModelSpace.AddRegion(TblSel)
   ' Obtention du périmètre de la 1ère région
   Resultat = RegionSel(0).Perimeter
   ' Affichage du périmètre de la 1ère région créée.
   MsgBox "Périmètre : " & Format(Resultat, "0.00")
   RegionSel(0).Erase
 Exit Sub
ErrorStop:
 MsgBox "Erreur dans la sélection de la région ;" & _
         vbCrLf & "Elle doit être fermée."
 Exit Sub
 
End Sub


Fasoft