Versions optimisées pour le VBA d'AutoCAD version 14.01, R2000, 2002 et 2004
Ces exemples ne peuvent pas fonctionner tels quels en simple Visual Basic (VBx).
1 - Fonctions de Dessin
| 1.1 - Dessin d'une ligne donnée dans l'espace objet |
'Initialisation des variables
Dim BaLigne As AcadLine ' Nom arbitraire de la variable objet ligne
Dim PtDep(0 To 2) As Double ' Les variables des Points definies comme nombres
Dim PtFin(0 To 2) As Double ' a virgule flottante en double precision
'Donnees
PtDep(0) = 10# ' Coordonnee en X du premier point
PtDep(1) = 20# ' Coordonnee en Y du premier point
PtDep(2) = 0# ' Coordonnee en Z du premier point
PtFin(0) = 60# ' Coordonnee en X du second point
PtFin(1) = 100# ' Coordonnee en Y du second point
PtFin(2) = 0# ' Coordonnee en Z du second point
'Creation de la ligne en Espace Objet
Set BaLigne = ThisDrawing.ModelSpace.AddLine(PtDep, PtFin)
|
| 1.2 - Dessin d'un cercle dans l'espace objet |
'Initialisation des variables
Dim BaCercle As AcadCircle ' Nom arbitraire de la variable objet cercle
Dim PtCentre(0 To 2) As Double ' Les variables definies comme des nombres
Dim LgRayon As Double ' a virgule flottante en double precision
'Donnees
PtCentre(0) = 100# ' Coordonnee en X du centre
PtCentre(1) = 200# ' Coordonnee en Y du centre
PtCentre(2) = 0# ' Coordonnee en Z du centre
LgRayon = 50# ' Longueur du rayon du cercle
' Creation du cercle en Espace Objet
Set BaCercle = ThisDrawing.ModelSpace.AddCircle(PtCentre, LgRayon)
|
| 1.2bis - Dessin d'un cercle dans l'espace papier |
' Le code est presque identique au listing ci-dessus ; il suffit de remplacer
' ModelSpace par PaperSpace dans la derniere ligne :
Set BaCercle = ThisDrawing.PaperSpace.AddCircle(PtCentre, LgRayon)
' Bien entendu pour voir le cercle, vous devez etre en espace papier.
|
| 1.3 - Dessin d'un cercle en choisissant le centre |
'Initialisation des variables
Dim BaCercle As Object ' Nom arbitraire de la variable objet cercle
Dim PtCentre As Variant ' variable definie du type variant
Dim LgRayon As Double
' On cache la feuille pour pouvoir positionner le centre
UserForm1.Hide
'Donnees
LgRayon = 70# ' Longueur du rayon du cercle
' On demande de positionner le centre
PtCentre = ThisDrawing.Utility.GetPoint(, "Centre du cercle :")
'Création du cercle
Set BaCercle = ThisDrawing.ModelSpace.AddCircle(PtCentre, LgRayon)
|
| 1.4 - Dessin d'un arc de cercle dans l'espace objet |
'Initialisation des variables
Dim BaArc As Object ' Nom arbitraire de la variable objet arc
Dim PtCentre(0 To 2) As Double ' Les variables definies comme des nombres
Dim LgRayon As Double ' a virgule flottante en double precision
Dim AngleDepDeg As Double ' Angle forme par le Pt de Depart en degre
Dim AngleDepRad As Double ' Angle forme par le Pt de Depart en radian
Dim AngleFinDeg As Double ' Angle forme par le Pt de fin en degre
Dim AngleFinRad As Double ' Angle forme par le Pt de fin en radian
'Donnees
PtCentre(0) = 200# ' Coordonnee en X du centre
PtCentre(1) = 100# ' Coordonnee en Y du centre
PtCentre(2) = 0# ' Coordonnee en Z du centre
LgRayon = 80# ' Longueur du rayon du cercle
AngleDepDeg = 30# ' Angle de depart a 30 degres
AngleFinDeg = 180# ' Angle de fin a 180 degres
AngleDepRad = AngleDepDeg * 3.141592 / 180# ' Transformation en radians
AngleFinRad = AngleFinDeg * 3.141592 / 180# ' Transformation en radians
'Creation de l'arc
Set BaArc = ThisDrawing.ModelSpace.AddArc(PtCentre, LgRayon, AngleDepRad, AngleFinRad)
|
| 1.5 - Dessin d'un quadrilatère dans l'espace objet |
'Initialisation des variables
Dim BaQuadr As Object ' Nom de la variable objet Quadrilatere
Dim PtSommet(0 To 9) As Double ' Sommets du quadrilatere
'Donnees
PtSommet(0) = 10# ' Coordonnee en X du premier point
PtSommet(1) = 20# ' Coordonnee en Y du premier point
PtSommet(2) = 100# ' Coordonnee en X du 2ème point
PtSommet(3) = 25# ' Coordonnee en Y du 2ème point
PtSommet(4) = 120# ' Coordonnee en X du 3ème point
PtSommet(5) = 70# ' Coordonnee en Y du 3ème point
PtSommet(6) = 30# ' Coordonnee en X du 4ème point
PtSommet(7) = 50# ' Coordonnee en Y du 4ème point
PtSommet(8) = 10# ' Coordonnee en X du premier point pour clore
PtSommet(9) = 20# ' Coordonnee en Y du premier point pour clore
'Creation du quadrilatere
Set BaQuadr = ThisDrawing.ModelSpace.AddLightWeightPolyline(PtSommet)
BaQuadr.Closed = True
BaQuadr.Update ' Mise a jour de l'affichage
' Bien ententu vous pouvez augmenter le nombre de sommets de la meme facon.
' Notez qu'il n'y a pas de valeurs en Z avec LightWeightPolyline.
|
2 - Fonctions d'Edition
| 2.1 - Création puis déplacement d'un cercle |
'Initialisation des variables
Dim BaCercle As Object ' Nom arbitraire de la variable objet cercle
Dim PtCentre(0 To 2) As Double ' Les variables definies comme des nombres
Dim LgRayon As Double ' a virgule flottante en double precision
Dim NewCentre(0 To 2) As Double
'Donnees
PtCentre(0) = 100# ' Coordonnee en X du centre
PtCentre(1) = 200# ' Coordonnee en Y du centre
PtCentre(2) = 0# ' Coordonnee en Z du centre
NewCentre(0) = 300# ' Nouvelle coordonnee en X du centre
NewCentre(1) = 150# ' Nouvelle coordonnee en Y du centre
NewCentre(2) = 0# ' Nouvelle coordonnee en Z du centre
LgRayon = 50# ' Longueur du rayon du cercle
' Creation du cercle
Set BaCercle = ThisDrawing.ModelSpace.AddCircle(PtCentre, LgRayon)
BaCercle.Update ' Mise a jour de l'affichage
MsgBox "Le cercle a été créé. Nous allons maintenant procéder au déplacement."
BaCercle.Move PtCentre, NewCentre
BaCercle.Update ' Mise a jour de l'affichage
MsgBox "Le cercle a été déplacé."
|
| 2.2 - Déplacement de toutes les entités |
'Initialisation des variables
Dim BaSelect As AcadSelectionSet
Dim PtBase(0 To 2) As Double
Dim PtDecal(0 To 2) As Double
Dim I As Integer
'Donnees
PtBase(0) = 0# ' Coordonnees en X du point de base
PtBase(1) = 0# ' Coordonnees en Y du point de base
PtBase(2) = 0# ' Coordonnees en Z du point de base
PtDecal(0) = 300# ' Nouvelle coordonnee en X du decalage
PtDecal(1) = 150# ' Nouvelle coordonnees en Y du decalage
PtDecal(2) = 0# ' Nouvelle coordonnees en Z du decalage
'Creation du jeu de selection
Set BaSelect = ThisDrawing.SelectionSets.Add("BaVBa")
'Selection de toutes les entites
BaSelect.Select acSelectionSetAll
For I = 1 To BaSelect.Count
'le decompte commence a zero, c'est pourquoi on retire 1 de I
BaSelect.Item(I - 1).Move PtBase, PtDecal
BaSelect.Item(I - 1).Update
MsgBox "L'Item " & I & " du jeu de selection a été déplacé."
Next I
|
| 2.3 - Déplacement d'un jeu de sélection |
'Initialisation des variables
Dim BaSelect As AcadSelectionSet
Dim PtBase(0 To 2) As Double
Dim PtDecal(0 To 2) As Double
Dim I As Integer
'Donnees
PtBase(0) = 0# ' Coordonnees en X du point de base
PtBase(1) = 0# ' Coordonnees en Y du point de base
PtBase(2) = 0# ' Coordonnees en Z du point de base
PtDecal(0) = 200# ' Nouvelle coordonnee en X du decalage
PtDecal(1) = 100# ' Nouvelle coordonnees en Y du decalage
PtDecal(2) = 0# ' Nouvelle coordonnees en Z du decalage
'Creation du jeu de selection
Set BaSelect = ThisDrawing.SelectionSets.Add("BaVBa")
'On cache la feuille pour acceder a AutoCAD
UserForm1.Hide
'Choix des entites
Call BaSelect.SelectOnScreen
'Deplacement des objets selectionnes
For I = 1 To BaSelect.Count
BaSelect.Item(I - 1).Move PtBase, PtDecal
BaSelect.Item(I - 1).Update
Next I
UserForm1.Show
|
| 2.4 - Effacement d'objets sélectionnés |
'Initialisation des variables
Dim BaSelect As AcadSelectionSet
Dim I As Integer
' Creation du jeu de selection
Set BaSelect = ThisDrawing.SelectionSets.Add("BaVBa")
'On cache la feuille pour la selection
UserForm1.Hide
'Selection des entites
Call BaSelect.SelectOnScreen
'Deplacement des objets selectionnes
For I = 1 To BaSelect.Count
BaSelect.Item(I - 1).Erase
Next I
' Mise a jour de l'ecran
ThisDrawing.Regen True
MsgBox "Les " & BaSelect.Count & " entités sélectionnées ont été effacées"
UserForm1.Show
|
| 2.5 - Copie d"entités sélectionnées |
'Initialisation des variables
Dim BaSelect As AcadSelectionSet
Dim BaCopie As Object
Dim PtBase(0 To 2) As Double
Dim PtDecal(0 To 2) As Double
Dim I As Integer
'Donnees
PtBase(0) = 0# ' Coordonnees en X du point de base
PtBase(1) = 0# ' Coordonnees en Y du point de base
PtBase(2) = 0# ' Coordonnees en Z du point de base
PtDecal(0) = 200# ' Nouvelle coordonnee en X du decalage
PtDecal(1) = 100# ' Nouvelle coordonnees en Y du decalage
PtDecal(2) = 0# ' Nouvelle coordonnees en Z du decalage
' Creation du jeu de selection
Set BaSelect = ThisDrawing.SelectionSets.Add("BaVBa")
'On cache la feuille
UserForm1.Hide
'Selection des entites
Call BaSelect.SelectOnScreen
'Copie puis Deplacement des objets selectionnes
For I = 1 To BaSelect.Count
Set BaCopie = BaSelect.Item(I - 1).Copy
BaCopie.Move PtBase, PtDecal
Next I
ThisDrawing.Regen True
UserForm1.Show
|
| 2.6 - Obtenir l'arrondi d'un nombre |
' L'utilisation de la fonction "format" est dans ce cas, le plus simple :
nb1 = 25.23546789
MsgBox nb1 & " avec 0.000 donnera " & Format(nb1, "0.000") ' résultat 25.235
nb2 = 25.23556789
MsgBox nb2 & " avec 0.000 donnera " & Format(nb2, "0.000") ' résultat 25.236
nb3 = 25.23456789
MsgBox nb3 & " avec 0.0 donnera " & Format(nb3, "0.0") ' résultat 25.2
nb4 = 25.25556789
MsgBox nb4 & " avec 0.0 donnera " & Format(nb4, "0.0") ' résultat 25.3
nb5 = 25.23456789
MsgBox nb5 & " avec 0 donnera " & Format(nb5, "0") ' résultat 25
nb6 = 25.55556789
MsgBox nb6 & " avec 0 donnera " & Format(nb6, "0") ' résultat 26
|
3 - Sélection d'Objets
'Initialisation des variables
Dim BaSelect As AcadSelectionSet
'Creation du jeu de selection
Set BaSelect = ThisDrawing.SelectionSets.Add("BaVBa")
'Selection de toutes les entites
BaSelect.Select acSelectionSetAll
MsgBox "Il y a " & BaSelect.Count & " entités sélectionnées dans ce dessin"
|
| 3.2 - Sélection d'une Fenêtre |
'Initialisation des variables
Dim BaSelect As AcadSelectionSet
Dim Pt1(0 To 2) As Double
Dim Pt2(0 To 2) As Double
Dim I As Integer
'Donnees : coordonnées de la fenetre
Pt1(0) = 50# ' Coordonnee en X du premier point de la fenetre
Pt1(1) = 100# ' Coordonnee en Y du premier point de la fenetre
Pt1(2) = 0# ' Coordonnee en Z du premier point de la fenetre
Pt2(0) = 150# ' Coordonnee en X du second point de la fenetre
Pt2(1) = 300# ' Coordonnee en Y du second point de la fenetre
Pt2(2) = 0# ' Coordonnee en Z du second point de la fenetre
'Creation du jeu de selection
Set BaSelect = ThisDrawing.SelectionSets.Add("BaVBa")
'Selection de toutes les entites dans la fenetre
BaSelect.Select acSelectionSetWindow, Pt1, Pt2
For I = 1 To BaSelect.Count
MsgBox "L'entité n° " & I & " du jeu de sélection est du type codé " & _
BaSelect.Item(I - 1).EntityType
Next I
MsgBox "Il y a " & BaSelect.Count & " entités sélectionnées dans cette fenêtre"
|
| 3.3 - Sélection par Capture |
'Initialisation des variables
Dim BaSelect As AcadSelectionSet
Dim Pt1(0 To 2) As Double
Dim Pt2(0 To 2) As Double
Dim I As Integer
'Donnees
Pt1(0) = 50# ' Coordonnee en X du premier point de la fenetre
Pt1(1) = 100# ' Coordonnee en Y du premier point de la fenetre
Pt1(2) = 0# ' Coordonnee en Z du premier point de la fenetre
Pt2(0) = 150# ' Coordonnee en X du second point de la fenetre
Pt2(1) = 300# ' Coordonnee en Y du second point de la fenetre
Pt2(2) = 0# ' Coordonnee en Z du second point de la fenetre
'Creation du jeu de selection
Set BaSelect = ThisDrawing.SelectionSets.Add("BaVBa")
'Selection de toutes les entites dans la fenetre
BaSelect.Select acSelectionSetCrossing, Pt1, Pt2
For I = 1 to BaSelect.Count
MsgBox "L'entité n° " & I & " du jeu de sélection est du type codé " & _
BaSelect.Item(I-1).EntityType
Next I
MsgBox "Il y a " & BaSelect.Count & " entités sélectionnées dans cette capture"
|
| 3.4 - Filtres de Sélection |
'Cet exemple selectionne tous les cercles du dessin
'Initialisation des variables
Dim BaSelect As AcadSelectionSet
Dim CodeGroup(0) as Integer
Dim ValGroup(0) as Variant
'Creation du jeu de selection
Set BaSelect = ThisDrawing.SelectionSets.Add("BaVBa")
' Choix des filtres
CodeGroup(0) = 0 ' Code DXF pour le type d'entites
ValGroup(0) = "CIRCLE" ' Type = un cercle
'Selection
BaSelect.Select acSelectionSetAll, , ,CodeGroup, ValGroup
MsgBox "Il y a " & BaSelect.Count & " entités cercles dans ce dessin"
|
| 3.5 - Filtres multiples de Sélection |
'Selection des LIGNES de couleur BLEUE dans le calque Plan01 et dans une fenetre
'Initialisation des variables
Dim BaSelect As AcadSelectionSet
Dim Pt1(0 To 2) As Double
Dim Pt2(0 To 2) As Double
Dim CodeGroup(0 To 2) as Integer
Dim ValGroup(0 To 2) as Variant
Dim I As Integer
'Donnees
Pt1(0) = 50# ' Coordonnee en X du premier point de la fenetre
Pt1(1) = 100# ' Coordonnee en Y du premier point de la fenetre
Pt1(2) = 0# ' Coordonnee en Z du premier point de la fenetre
Pt2(0) = 250# ' Coordonnee en X du second point de la fenetre
Pt2(1) = 300# ' Coordonnee en Y du second point de la fenetre
Pt2(2) = 0# ' Coordonnee en Z du second point de la fenetre
'Creation du jeu de selection
Set BaSelect = ThisDrawing.SelectionSets.Add("BaVBa")
'Choix des filtres
CodeGroup(0) = 0 ' Code DXF pour le type d'entites
ValGroup(0) = "LINE" ' Type = une ligne
CodeGroup(1) = 62 ' Code DXF pour le numero de couleur
ValGroup(1) = 5 ' 5 = bleu
CodeGroup(2) = 8 ' Code DXF pour le nom de calque
ValGroup(2) = "Plan01" ' Nom du calque = Plan01
'Selection des entites dans la fenetre
BaSelect.Select acSelectionSetWindow, Pt1, Pt2, CodeGroup, ValGroup
For I = 1 to BaSelect.Count
MsgBox "L'entité n° " & I & " du jeu de sélection est du type codé " & _
BaSelect.Item(I-1).EntityType
Next I
MsgBox "Il y a " & BaSelect.Count & " entités sélectionnées dans cette fenêtre"
|
| 3.6 - Filtres avec opérateur conditionnel OU |
'Meme exemple que le precedent N° 3.5, mais on selectionne egalement les cercles.
'Selection des LIGNES et CERCLES de couleur BLEUE dans le calque Plan01
' et dans une fenetre
'On utilise l'operateur logique OU (Code DXF -4).
'Initialisation des variables
Dim BaSelect As AcadSelectionSet
Dim Pt1(0 To 2) As Double
Dim Pt2(0 To 2) As Double
Dim CodeGroup(0 To 5) as Integer
Dim ValGroup(0 To 5) as Variant
Dim I As Integer
'Donnees
Pt1(0) = 50# ' Coordonnee en X du premier point de la fenetre
Pt1(1) = 50# ' Coordonnee en Y du premier point de la fenetre
Pt1(2) = 0# ' Coordonnee en Z du premier point de la fenetre
Pt2(0) = 350# ' Coordonnee en X du second point de la fenetre
Pt2(1) = 300# ' Coordonnee en Y du second point de la fenetre
Pt2(2) = 0# ' Coordonnee en Z du second point de la fenetre
'Creation du jeu de selection
Set BaSelect = ThisDrawing.SelectionSets.Add("BaVBa")
'Choix des filtres
CodeGroup(0) = -4 ' Code DXF pour l'operateur logique
ValGroup(0) = "<OR" ' Debut OU
CodeGroup(1) = 0 ' Code DXF pour le type d'entites
ValGroup(1) = "LINE" ' Type = une ligne
CodeGroup(2) = 0 ' Code DXF pour le type d'entites
ValGroup(2) = "CIRCLE" ' Type = un cercle
CodeGroup(3) = -4 ' Code DXF pour l'operateur logique
ValGroup(3) = "OR>" ' Fin OU
CodeGroup(4) = 62 ' Code DXF pour le numero de couleur
ValGroup(4) = 5 ' 5 = bleu
CodeGroup(5) = 8 ' Code DXF pour le nom de calque
ValGroup(5) = "Plan01" ' Nom du calque = Plan01
'Selection des entites dans la fenetre
BaSelect.Select acSelectionSetWindow, Pt1, Pt2, CodeGroup, ValGroup
For I = 1 to BaSelect.Count
MsgBox "L'entité n° " & I & " du jeu de sélection est du type codé " & _
BaSelect.Item(I-1).EntityType
Next I
MsgBox "Il y a " & BaSelect.Count & " entités sélectionnées dans cette fenêtre"
|
| 3.7 - Filtres avec opérateur conditionnel ET |
'Cette fois, sur l'ensemble du dessin,
'Selection des LIGNES dans le calque Plan01 et des CERCLES de couleur BLEUE.
'On utilise les operateurs logiques ET et OU (Code DXF -4).
'Initialisation des variables
Dim BaSelect As AcadSelectionSet
Dim CodeGroup(0 To 9) as Integer
Dim ValGroup(0 To 9) as Variant
'Creation du jeu de selection
Set BaSelect = ThisDrawing.SelectionSets.Add("BaVBa")
'Choix des filtres
CodeGroup(0) = -4 ' Code DXF pour l'operateur logique
ValGroup(0) = "<OR" ' Debut OU
CodeGroup(1) = -4 ' Code DXF pour l'operateur logique
ValGroup(1) = "<AND" ' Debut ET
CodeGroup(2) = 0 ' Code DXF pour le type d'entites
ValGroup(2) = "LINE" ' Type = une ligne
CodeGroup(3) = 8 ' Code DXF pour le nom de calque
ValGroup(3) = "Plan01" ' Nom du calque = Plan01
CodeGroup(4) = -4 ' Code DXF pour l'operateur logique
ValGroup(4) = "AND>" ' Fin ET
CodeGroup(5) = -4 ' Code DXF pour l'operateur logique
ValGroup(5) = "<AND" ' Debut ET
CodeGroup(6) = 0 ' Code DXF pour le type d'entites
ValGroup(6) = "CIRCLE" ' Type = un cercle
CodeGroup(7) = 62 ' Code DXF pour le numero de couleur
ValGroup(7) = 5 ' 5 = bleu
CodeGroup(8) = -4 ' Code DXF pour l'operateur logique
ValGroup(8) = "AND>" ' Fin ET
CodeGroup(9) = -4 ' Code DXF pour l'operateur logique
ValGroup(9) = "OR>" ' Fin OU
'Selection
BaSelect.Select acSelectionSetAll, , , CodeGroup, ValGroup
MsgBox "Il y a " & BaSelect.Count & " entités sélectionnées dans ce dessin"
|
4 - Environnement de travail
| 4.1 - Créer un nouveau calque |
' Creation d'un nouveau calque Plan02
' Puis on rend se calque courant
' Si le calque Plan02 existe deja, le rend courant.
' Initialisation des variables
Dim BaCalque As AcadLayer
' Creation du calque
Set BaCalque = ThisDrawing.Layers.Add("Plan02")
' Le calque cree est rendu courant
ThisDrawing.ActiveLayer = BaCalque
|
| 4.2 - Définir le calque courant |
' Definit le calque Plan03 courant
' Si le calque Plan03 n'existe pas, provoque une erreur.
' Initialisation des variables
Dim BaCalque As AcadLayer
' Choix du calque
Set BaCalque = ThisDrawing.Layers.Item("Plan03")
' Le calque est rendu courant
ThisDrawing.ActiveLayer = BaCalque
|
| 4.3 - Etablir la liste des calques |
' Initialisation des variables
Dim ListeCalque As String
Dim I As Integer
For I = 0 To ThisDrawing.Layers.Count - 1
ListeCalque = ListeCalque & ThisDrawing.Layers.Item(I).Name & Chr$(13)
Next I
MsgBox ListeCalque
|
| 4.4 - Changer la couleur d'un calque |
' Plan01 est le nom du calque a modifier,
' 5 est le code de la nouvelle couleur
ThisDrawing.Layers.Item("Plan01").Color = 5
|
| 4.5 - Fixer l'Elévation en espace objet |
ThisDrawing.ElevationModelSpace = 75
|
| 4.5b - Fixer l'Elévation en espace papier |
ThisDrawing.ElevationPaperSpace = 200
|
| 4.6 - Zoom Etendu dans l'Espace Papier |
ThisDrawing.ActiveSpace = acPaperSpace
ThisDrawing.MSpace = False
ThisDrawing.ActivePViewport.ZoomExtents
|
| 4.7 - Se mettre dans le SCU Général |
Dim origine(0 To 2) As Double
Dim x(0 To 2) As Double
Dim y(0 To 2) As Double
Dim NouveauScu As AcadUCS
origine(0) = 0
origine(1) = 0
origine(2) = 0
x(0) = 1
x(1) = 0
x(2) = 0
y(0) = 0
y(1) = 1
y(2) = 0
Set NouveauScu = ThisDrawing.UserCoordinateSystems.Add(origine, x, y, "SCG")
ThisDrawing.ActiveUCS = NouveauScu
|
| 4.8 - Donner les coordonnées du centre d'un cercle
sélectionné par l'utilisateur |
Dim BaCercle As Object ' Nom arbitraire de la variable objet cercle
Dim PtCentre As Variant ' variable definie du type variant
' On cache la feuille pour pouvoir choisir une entité
UserForm1.Hide
' La ligne suivante attend une sélection de l'utilisateur
ThisDrawing.Utility.GetEntity BaCercle, PtCentre, "Sélectionnez un cercle :"
' Recherche du type de l'entité choisie
BaCercle_Type = BaCercle.EntityName
If BaCercle_Type = "AcDbCircle" Then
' La propriété center donne le centre
PtCentre = BaCercle.Center
MsgBox "Les coordonnées du centre du cercle sont : " & PtCentre(0) & " - " _
& PtCentre(1) & " - " & PtCentre(2)
Else
MsgBox "L'entité sélectionnée n'est pas un cercle !"
End If
|
Dim NomBloc As String
Dim BaSelect As Object
'Emplacement et nom du bloc
NomBloc = "C:\acadr14\bib5\Test1.dwg"
Set BaSelect = ThisDrawing.SelectionSets.Add("BaVBa")
UserForm1.Hide
'Selection des entites
BaSelect.SelectOnScreen
'Creation du bloc
ThisDrawing.Wblock NomBloc, BaSelect
ThisDrawing.Regen True
MsgBox "Le bloc " & NomBloc & " a été créé avec succès !"
|
|
