sous insertblocs()
-----------------------------------------------------------------------------------------------------------------
« Insère des blocs dans l'autocad en utilisant des données - point d'insertion, nom de bloc/chemin complet, facteurs d'échelle, angle de rotation - d'excel.
Notez que le nom du bloc ou le chemin du bloc doit déjà exister, sinon rien ne sera inséré.
«le code utilise une liaison tardive, donc aucune référence à une bibliothèque autocad (type) externe n'est requise.
Il va sans dire qu'autocad doit être installé sur votre ordinateur avant d'exécuter ce code.
'écrit par: Christos samaras
Date: 21/04/2014
Courriel: [email protected]
'site: http://www.myengineeringworld.net
-----------------------------------------------------------------------------------------------------------------
«déclaration des variables nécessaires.
dim acadapp comme objet
dim acaddoc comme objet
dim acadblock comme objet
dim lastrow aussi longtemps
DIM I aussi longtemps
dim insertion point(0 à 2) comme double
dim blockname en tant que chaîne
dim blockscale en tant que facteur d'échelle
dim angle de rotation double
'activer la feuille de coordonnées et trouver la dernière ligne.
avec feuilles("attributs")
.activé
Lastrow = .cells(.rows.count, "i").end(xlup). ligne
fin avec
vérifier s'il y a des coordonnées pour au moins un cercle.
si le dernier rang est < 5 alors
msgbox "il n'y a pas de coordonnées pour le point d'insertion!", vbcritic, "erreur de point d'insertion"
sortie sous
fin si
Vérifiez si l'application autocad est ouverte. si n'est pas ouvert créez une nouvelle instance et la rendre visible.
suite de l'erreur
définir acadapp = getobject(, "autocad.application")
si acadapp n'est rien alors
définir acadapp = createobject("autocad.application")
acadapp.visible = vrai
fin si
Vérifiez s'il y a un objet autocad.
si acadapp n'est rien alors
msgbox "désolé, il était impossible de démarrer autocad!", vbcritic, "erreur autocad"
sortie sous
fin si
en cas d'erreur aller à 0
'si aucun dessin actif n'en crée un nouveau.
suite de l'erreur
définir acaddoc = acadapp.activedocument
si acaddoc n'est rien alors
définir acaddoc = acadapp.documents.add
fin si
en cas d'erreur aller à 0
«Vérifiez si l'espace actif est de l'espace papier et changez-le en espace modèle.
si acaddoc.activespace = 0 alors '0 = acpaperspace dans la liaison précoce
acaddoc.activespace = 1 '1 = acmodelspace dans la liaison précoce
fin si
suite de l'erreur
'loop à travers toutes les lignes et ajouter les blocs correspondants dans autocad.
avec feuilles("attributs")
pour i = 5 à la dernière ligne
C'est le nom du bloc.
blockname = .range("l" & i). valeur
Si le nom du bloc n'est pas vide, insérez le bloc.
si blockname <> vbnullstring alors
'déterminez le point d'insertion.
point d'insertion(0) = .range("i" & i). valeur
point d'insertion(1) = .range("j" & i). valeur
insertionpoint(2) = .range("k" & i). valeur
'initialisez les paramètres optionnels.
blockscale.x = 1
blockscale.y = 1
blockscale.z = 1
angle de rotation = 0
définir les paramètres optionnels (s'il y a des valeurs sur les plages correspondantes).
if .range("m" & i).value <> vbnullstring puis blockscale.x = .range("m" & i). valeur
if .range("n" & i).value <> vbnullstring alors blockscale.y = .range("n" & i). valeur
if .range("o" & i).value <> vbnullstring alors blockscale.z = .range("o" & i). valeur
if .range("p" & i).value <> vbnullstring puis rotationangle = .range("p" & i).value
«Ajouter le bloc en utilisant les données de la feuille (point d'insertion, nom du bloc, facteurs d'échelle et angle de rotation).
Le 0,0174532925 est de convertir les degrés en radians.
définir acadblock = acaddoc.modelspace.insertblock(point d'insertion, nom de bloc, _
blockscale.x, blockscale.y, blockscale.z, angle de rotation * 0,0174532925)
fin si
Suivant
fin avec
Extrait d'appel
Mise à jour des appels
Zoom dans la zone de dessin.
acadapp.zoomextents
Libérez les objets.
définir acadblock = rien
définir acaddoc = rien
définir acadapp = rien
'informer l'utilisateur sur le processus.
msgbox "les blocs ont été insérés avec succès dans autocad!", vbinformation, "fini"
fin sous
