Insertion et manipulation de bloc dynamique dans Autocad depuis EXCEL

[GOLUM69]

Bonjour à tous, je suis en train de créer un applicatif qui me permet d’insérer des blocs dynamiques dans Autocad à partir d'Excel (pour création d'une vue de détail de soubassements y compris semelle et ferraillage). J'ai créer une bibliothèque de blocs dynamiques qui sont rangés dans un répertoire bien défini.

 

Ensuite dans EXCEL, j'ai créer un tableau avec le chemin d'accès de l'ensemble des blocs dynamiques présents dans le répertoire de blocs. J'ai ensuite créer plusieurs colonnes contenant les paramètres dynamiques propre à chaque blocs dynamiques répertoriés, ainsi que leur valeur que je leur ai attribué,

 

(ex:

Fichier bloc Paramètre 1 Valeur 1 Paramètre 2 Valeur 2 pt_base X pt_base Y pt_base Z

 

GROS BETON DE RATTRAPAGE

E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\B_bet_prop.dwg Visibilité1 50cm 0 0 0

 

SEMELLES

E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\R_Semelle_coffrage.dwg Visibilité1 50cm 0 0 0

 

SOUBASSEMENTS

E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\S_soub_bb.dwg nb_rangs 0,6 Visibilité1 bb_20 0 0,3 0

E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\T_soub_bc.dwg nb_rangs 0,6 Visibilité1 bc_20 0 0,3 0

 

ARASE HYDROFUGE

E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\A_arase.dwg Visibilité1 arase_20 ht_arase 0,05 0 0 0

 

PLANCHER POLYSTYRENE (pour soubassements largeur 20, 25, 27.5, 30cm)

E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\N_ph_poly_20.dwg Visibilité1 12+5 0 0 0

E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\O_ph_poly_25.dwg Visibilité1 12+5 0 0 0

E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\P_ph_poly_27.dwg Visibilité1 12+5 0 0 0

E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\Q_ph_poly_30.dwg Visibilité1 12+5 0 0 0

 

PLANCHER BETON (pour soubassements largeur 20, 25, 27.5, 30cm)

E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\J_ph_beton_20.dwg Visibilité1 12+5 0 0 0

E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\K_ph_beton_25.dwg Visibilité1 12+5 0 0 0

E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\L_ph_beton_27.dwg Visibilité1 12+5 0 0 0

E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\M_ph_beton_30.dwg Visibilité1 12+5 0 0 0

 

 

Voici un exemple, j'ai joint également une photo pour mieux visualiser ce que j'ai créer dans Excel.

 

Ensuite j'ai créer un début de code me permettant de piloter mes blocs dynamiques depuis Excel, j'ai réussi à le faire avec un de mes blocs dynamiques, mais quand je veut ensuite insérer un bloc à la suite de celui insérer précédemment cela ne fonctionne pas très bien car il se place au même point d'insertion que celui inséré précédemment. Et quand j'exécute le programme, le premier bloc dynamique inséré conserve ses paramètres dynamiques alors que ceux insérés à la suite perdent l'ensemble de leur paramètres dynamiques, mais ils restent encore en tant que blocs (mais leurs paramètres de visibilités, de hauteur, largeur ne n'apparaissent pas lors de l'insertion).

 

J'ai insérer en pièces jointes, l'ensemble des éléments crées à ce jour ainsi que le début de mon codage VBA.

 

 

CODAGE:

 

Option Explicit

Public AcadObj As Object

Public AcadDoc As Object

Public AcadUtil As Object

Public AcadEspaceObjet As Object

Sub InitialiserExport()

On Error Resume Next

Set AcadObj = GetObject(, "AutoCAD.Application")

If Err.Number <> 0 Then Set AcadObj = CreateObject("AutoCAD.Application")

AcadObj.Visible = True

'acaddoc est un lien sur le dessin Autocad en cours

Set AcadDoc = AcadObj.ActiveDocument

Set AcadUtil = AcadDoc.Utility

Set AcadEspaceObjet = AcadDoc.ModelSpace

End Sub

Sub TerminerExport()

'Raffraichissement de l'affichage AutoCAd

AcadObj.Update

'Liberation la mémoire

Set AcadObj = Nothing

End Sub

Function InsererBloc(NomBloc As String, PointInsertion As Variant) As AcadBlockReference

Dim ReferenceBloc As AcadBlockReference

On Error Resume Next

Set ReferenceBloc = AcadEspaceObjet.InsertBlock(PointInsertion, NomBloc, 1#, 1#, 1#, 0)

If Err.Number <> 0 Then

MsgBox ("Le fichier " & NomBloc & " n'existe pas")

Else

Set InsererBloc = ReferenceBloc

End If

End Function

Sub ChangerParametreDynamique(ReferenceBloc As AcadBlockReference, NomParametre As String, Valeur As Variant)

Dim Parametre As AcadDynamicBlockReferenceProperty, i As Integer

For i = 0 To UBound(ReferenceBloc.GetDynamicBlockProperties)

Set Parametre = ReferenceBloc.GetDynamicBlockProperties(i)

If Parametre.PropertyName = NomParametre Then

Parametre.Value = Valeur

Exit For

End If

'Stop

Next i

End Sub

Function LireParametreDynamique(ReferenceBloc As AcadBlockReference, NomParametre As String)

Dim Parametre As AcadDynamicBlockReferenceProperty, i As Integer

For i = 0 To UBound(ReferenceBloc.GetDynamicBlockProperties)

Set Parametre = ReferenceBloc.GetDynamicBlockProperties(i)

If Parametre.PropertyName = NomParametre Then

LireParametreDynamique = Parametre.Value

Exit For

End If

'Stop

Next i

End Function

Sub TestInsertionBlocDepuisExcel()

Dim PointInsertion(0 To 2) As Double, ReferenceBloc As AcadBlockReference, ReferenceBloc2 As AcadBlockReference, BlocDecompose As Variant

InitialiserExport

PointInsertion(0) = CDbl(Range("F2")): PointInsertion(1) = CDbl(Range("G2")): PointInsertion(2) = CDbl(Range("H2"))

Set ReferenceBloc = InsererBloc(Range("A2"), PointInsertion)

BlocDecompose = ReferenceBloc.Explode

Set ReferenceBloc2 = BlocDecompose(0)

ReferenceBloc.Delete

Call ChangerParametreDynamique(ReferenceBloc2, Range("B2"), CDbl(Range("C2")))

Call ChangerParametreDynamique(ReferenceBloc2, Range("D2"), CDbl(Range("E2")))

AcadObj.ZoomExtents

TerminerExport

End Sub

 

Sub TestInsertionBlocDepuisExcel()

Dim PointInsertion(0 To 2) As Double, ReferenceBloc As AcadBlockReference, ReferenceBloc2 As AcadBlockReference, BlocDecompose As Variant

InitialiserExport

PointInsertion(0) = CDbl(Range("F2")): PointInsertion(1) = CDbl(Range("G2")): PointInsertion(2) = CDbl(Range("H2"))

Set ReferenceBloc = InsererBloc(Range("A2"), PointInsertion)

BlocDecompose = ReferenceBloc.Explode

Set ReferenceBloc2 = BlocDecompose(0)

ReferenceBloc.Delete

Call ChangerParametreDynamique(ReferenceBloc2, Range("B2"), CDbl(Range("C2")))

Call ChangerParametreDynamique(ReferenceBloc2, Range("D2"), CDbl(Range("E2")))

AcadObj.ZoomExtents

TerminerExport

End Sub

 

Sub TestInsertionBlocAA()

Dim PointInsertion(0 To 2) As Double, ReferenceBloc As AcadBlockReference, ReferenceBloc2 As AcadBlockReference, BlocDecompose As Variant

Dim PositionBlocSuivant(0 To 2) As Double, ReferenceBlocSuivant As AcadBlockReference

 

InitialiserExport

PointInsertion(0) = 0: PointInsertion(1) = 0: PointInsertion(2) = 0

 

Set ReferenceBloc = InsererBloc("E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\S_soub_bb.dwg", PointInsertion)

BlocDecompose = ReferenceBloc.Explode

Set ReferenceBloc2 = BlocDecompose(0)

ReferenceBloc.Delete

Call ChangerParametreDynamique(ReferenceBloc2, "nb_rangs", 2#)

Call ChangerParametreDynamique(ReferenceBloc2, "Visibilité1", "bb_25")

MsgBox ("Repere X = " & LireParametreDynamique(ReferenceBloc2, "pt_base X") & " Repere Y = " & LireParametreDynamique(ReferenceBloc2, "Repere Y"))

PositionBlocSuivant(0) = LireParametreDynamique(ReferenceBloc2, "pt_base X")

PositionBlocSuivant(1) = LireParametreDynamique(ReferenceBloc2, "pt_base Y")

PositionBlocSuivant(2) = 0#

''Set ReferenceBlocSuivant = InsererBloc("E:\Projet_(EXCEL_VBA_AutoCad)\BibliothequeBlocsDyn\N_ph_poly_20.dwg", PositionBlocSuivant)

 

AcadObj.ZoomExtents

TerminerExport

End Sub