Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Programme VBA Excel pour création dessin dans autocad

GOLUM69

Par GOLUM69
dans VBA et VB

 Partager

Messages recommandés

GOLUM69 Newbie

GOLUM69

Posté(e)
Posté(e)

Bonjour à tous, je vous présente mon projet : Le but est de créer un dessin de vue de détails de soubassements dans Autocad à partir d'une feuille de calculs Excel. Je réalise le calcul des aciers nécessaires à la semelle dans Excel. J'ai en parallèle crée une bibliothèque de blocs dynamiques, qui vont me servir à créer la vue de détails la semelle avec le reste de la vue de soubassements, les blocs dynamiques peuvent être pilotés depuis Excel avant de les insérer dans Autocad. Pour cela j'ai donc mis en place un UserForm.

 

A ce jour le programme permet de calculer les aciers de la semelle puis d’insérer les blocs correspondants dans Autocad à partir de mon fichier Excel. Les blocs dynamiques s'imbriquent les uns sur les autres sans problème.

 

J'ai également créer des blocs avec attributs qui vont me servir de feuille de dessin A4 ou je souhaiterais y insérer une nouvelle fenêtre de présentation (Viewport) pour que le dessin tracé préalablement se retrouve au centre de ma feuille A4. J'ai réussi à faire en sorte que le dessin de la semelle ainsi que le reste de la vue de détails se retrouve dans l'espace "Objet" et que ma feuille A4 ("ReferenceBlocFeuilleA4") se retrouve dans l'espace "Papier".

 

&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

 

Les parties du code ou il y a un problème sont balisées entre

 

&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

 

 

!!! Mon problème se tourne vers la création de la fenêtre (viewport) depuis Excel, quand j'utilise le code concernant la création de la fenêtre dans "VBAIDE" d'AutoCad cela marche très bien mais quand j'effectue le code depuis Excel cela ne marche pas. Je ne comprend vraiment d’où viens le problème. !!!

 

!!! Un autre problème rencontré, et que je souhaiterais savoir comment manipuler les variables d'Autocad depuis Excel (EX : Gridmode, Osmode, Tilemode, ...). Je voudrais lors de l'exportation des blocs dans Autocad, pouvoir désactiver la grille du dessin (GRIDMODE "0") !!!

 

Voila c'est a peu près tout. Merci de me tenir au courant si quelqu'un est apte a m'aider. Merci d'avance a tout le monde. B):D

 

 


Public AcadObj As Object
Public AcadDoc As Object
Public AcadUtil As Object
Public AcadEspaceObjet As Object
Public AcadEspacePapier 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
   Set AcadEspacePapier = AcadDoc.PaperSpace
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

Function InsererBlocEspacePapier(NomBloc2 As String, PointInsertion2 As Variant) As AcadBlockReference
   Dim ReferenceBlocEspacePapier As AcadBlockReference
   On Error Resume Next
   Set ReferenceBlocEspacePapier = AcadEspacePapier.InsertBlock(PointInsertion2, NomBloc2, 1#, 1#, 1#, 0)
   If Err.Number <> 0 Then
       MsgBox ("Le fichier " & NomBloc2 & " n'existe pas")
   Else
       Set InsererBlocEspacePapier = ReferenceBlocEspacePapier
   End If
End Function


Sub DessinerVueDetails()

   Dim PointInsertion(0 To 2) As Double, ReferenceBloc As AcadBlockReference, ReferenceBloc2 As AcadBlockReference, BlocDecompose As Variant
   Dim PositionBlocSemelle(0 To 2) As Double, ReferenceBlocSemelle As AcadBlockReference
   Dim PositionBlocSoubassement(0 To 2) As Double, ReferenceBlocSoubassement As AcadBlockReference
   Dim PositionBlocArase(0 To 2) As Double, ReferenceBlocArase As AcadBlockReference
   Dim PositionBlocPlancher(0 To 2) As Double, ReferenceBlocPlancher As AcadBlockReference
   Dim PositionBlocElevation(0 To 2) As Double, ReferenceBlocElevation As AcadBlockReference
   '''''''''''''''''''''''''''''''''''
   Dim FeuilleA4 As AcadBlockReference
   Dim PosFeuilleA4(0 To 2) As Double, ReferenceBlocFeuilleA4 As AcadBlockReference
   Dim HypoA4 As AcadBlockReference
   Dim PosHypoA4(0 To 2) As Double, ReferenceBlocHypoA4 As AcadBlockReference
   Dim CarnetA4 As AcadBlockReference
   Dim PosCarnetA4(0 To 2) As Double, ReferenceBlocCarnetA4 As AcadBlockReference
   
   
   Dim JJ As Integer
 
   InitialiserExport


&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

''''DESACTIVATION DE LA GRILLE LORS DE L'EXECUTION DU DESSIN'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      
   
   'This example toggles the setting of GridOn.
   Dim viewportObj As AcadViewport
   'Set the viewportObj variable to the activeviewport
   Set viewportObj = ThisDrawing.ActiveViewport

TOGGLEGRID:
   
   If MsgBox("Toggle the grid?", vbOKCancel, "GridOn Example") = vbOK Then
       viewportObj.GridOn = Not (viewportObj.GridOn)
   Else
      Exit Sub
   End If
   
   ' Reset the active viewport to see the change
   ThisDrawing.ActiveViewport = viewportObj
   
   GoTo TOGGLEGRID

    
''''INSERTION PAGE DE GARDE CARNET + HYPOTHESES A4 + CARTOUCHE A4 '''''''''''''''''''''''''''''''''''''''''''''''''''''''
   

   PosCarnetA4(0) = -420
   PosCarnetA4(1) = 0#
   PosCarnetA4(2) = 0#
   Set ReferenceBlocCarnetA4 = InsererBlocEspacePapier(Range("A41"), PosCarnetA4)
   BlocDecompose = ReferenceBlocCarnetA4.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocCarnetA4.Delete
   
   PosHypoA4(0) = -210
   PosHypoA4(1) = 0#
   PosHypoA4(2) = 0#
   Set ReferenceBlocHypoA4 = InsererBlocEspacePapier(Range("A40"), PosHypoA4)
   BlocDecompose = ReferenceBlocHypoA4.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocHypoA4.Delete
   
   If JJ = 0 Then
   PosFeuilleA4(0) = 0#
   PosFeuilleA4(1) = 0#
   PosFeuilleA4(2) = 0#
   Set ReferenceBlocFeuilleA4 = InsererBlocEspacePapier(Range("A39"), PosFeuilleA4)
   BlocDecompose = ReferenceBlocFeuilleA4.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocFeuilleA4.Delete
   End If
   
   
   AcadEspacePapier.ActiveSpace = acPaperSpace

   Dim Fenetre As AcadPViewport
   Dim Centre(0 To 2) As Double
   
   Centre(0) = 157
   Centre(1) = 105
   Centre(2) = 0
   
   Set Fenetre = AcadEspacePapier.AddPViewport(Centre, 260, 190)

   'Activation de la fenêtre
   Fenetre.Display True
   'Basculer dans l'espace papier
   AcadEspaceObjet.MSpace = True

   ZoomExtents

   'Rendre la fenêtre courante
   AcadEspacePapier.ActivePViewport = Fenetre
   'Désactiver l'édition de l'espace objet
   AcadEspaceObjet.MSpace = False

   ZoomExtents

&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&              
                   
''''BLOC GROS BETON DE RATTRAPAGE'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
   PointInsertion(0) = CDbl(Range("N3")): PointInsertion(1) = CDbl(Range("O3")): PointInsertion(2) = CDbl(Range("P3"))
   Set ReferenceBloc = InsererBloc(Range("A3"), PointInsertion)
   BlocDecompose = ReferenceBloc.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBloc.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B3"), (Range("C3")))     'Visibilité1
   
''''BLOCS SEMELLES FILANTES + FERRAILLAGE''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
   'Bloc Semelle avec U pour attentes
   
   If Worksheets("BlocsDynVBA").Range("Q6") = "Oui" Then
   
   PositionBlocSemelle(0) = LireParametreDynamique(ReferenceBloc2, "pt_base_sem X")
   PositionBlocSemelle(1) = LireParametreDynamique(ReferenceBloc2, "pt_base_sem Y")
   PositionBlocSemelle(2) = 0#
   
   Set ReferenceBlocSemelle = InsererBloc(Range("A6"), PositionBlocSemelle)
   BlocDecompose = ReferenceBlocSemelle.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocSemelle.Delete
       
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B6"), CDbl(Range("C6")))  'ht_sem
   Call ChangerParametreDynamique(ReferenceBloc2, Range("D6"), CDbl(Range("E6")))  'larg_sem
   Call ChangerParametreDynamique(ReferenceBloc2, Range("F6"), CDbl(Range("G6")))  'C_nom_X
   Call ChangerParametreDynamique(ReferenceBloc2, Range("H6"), CDbl(Range("I6")))  'C_nom_Y
   Call ChangerParametreDynamique(ReferenceBloc2, Range("J6"), CDbl(Range("K6")))  'ht_U_attente
   Call ChangerParametreDynamique(ReferenceBloc2, Range("L6"), CDbl(Range("M6")))  'larg_U
   
   End If
       
   'Bloc Semelle sans attentes
   
   If Worksheets("BlocsDynVBA").Range("Q7") = "Oui" Then
   
   PositionBlocSemelle(0) = LireParametreDynamique(ReferenceBloc2, "pt_base_sem X")
   PositionBlocSemelle(1) = LireParametreDynamique(ReferenceBloc2, "pt_base_sem Y")
   PositionBlocSemelle(2) = 0#
   
   Set ReferenceBlocSemelle = InsererBloc(Range("A7"), PositionBlocSemelle)
   BlocDecompose = ReferenceBlocSemelle.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocSemelle.Delete
       
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B7"), CDbl(Range("C7")))  'ht_sem
   Call ChangerParametreDynamique(ReferenceBloc2, Range("D7"), CDbl(Range("E7")))  'larg_sem
   Call ChangerParametreDynamique(ReferenceBloc2, Range("F7"), CDbl(Range("G7")))  'C_nom_X
   Call ChangerParametreDynamique(ReferenceBloc2, Range("H7"), CDbl(Range("I7")))  'C_nom_Y
   
   End If

   
''''BLOCS VOILES SOUBASSEMENTS''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
   'Bloc agglos creux de soubassements
   
   If Worksheets("BlocsDynVBA").Range("Q11") = "Oui" Then
   
   PositionBlocSoubassement(0) = LireParametreDynamique(ReferenceBloc2, "pt_base_soub X")
   PositionBlocSoubassement(1) = LireParametreDynamique(ReferenceBloc2, "pt_base_soub Y")
   PositionBlocSoubassement(2) = 0#
   
   Set ReferenceBlocSoubassement = InsererBloc(Range("A11"), PositionBlocSoubassement)
   BlocDecompose = ReferenceBlocSoubassement.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocSoubassement.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B11"), CDbl(Range("C11")))  'nb_rangs
   Call ChangerParametreDynamique(ReferenceBloc2, Range("D11"), (Range("E11")))      'Visibilité1

   End If
   
   'Bloc Agglos à bancher de soubassements
   
   If Worksheets("BlocsDynVBA").Range("Q10") = "Oui" Then
   
   PositionBlocSoubassement(0) = LireParametreDynamique(ReferenceBloc2, "pt_base_soub X")
   PositionBlocSoubassement(1) = LireParametreDynamique(ReferenceBloc2, "pt_base_soub Y")
   PositionBlocSoubassement(2) = 0#
   
   Set ReferenceBlocSoubassement = InsererBloc(Range("A10"), PositionBlocSoubassement)
   BlocDecompose = ReferenceBlocSoubassement.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocSoubassement.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B10"), CDbl(Range("C10")))  'nb_rangs
   Call ChangerParametreDynamique(ReferenceBloc2, Range("D10"), (Range("E10")))      'Visibilité1

   End If

'''''BLOC ARASE HYDROFUGE''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

   PositionBlocArase(0) = 0#                                                           'LireParametreDynamique(ReferenceBloc2, "pt_base_soub X")
   PositionBlocArase(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB"))        'LireParametreDynamique(ReferenceBloc2, "pt_base_soub Y")
   PositionBlocArase(2) = 0#
   
   Set ReferenceBlocArase = InsererBloc(Range("A14"), PositionBlocArase)
   
   BlocDecompose = ReferenceBlocArase.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocArase.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B14"), (Range("C14")))      'Visibilité1
   Call ChangerParametreDynamique(ReferenceBloc2, Range("D14"), CDbl(Range("E14")))  'ht_arase


'''''BLOCS PLANCHER HAUT VIDE SANITAIRE POLYSTYRENE''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

   '--Bloc Plancher polystyrène pour soubassement d'épaisseur 20cm--'
   
   If Worksheets("BlocsDynVBA").Range("Q17") = "Oui" Then
       
   PositionBlocPlancher(0) = 0#
   PositionBlocPlancher(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR"))
   PositionBlocPlancher(2) = 0#
   
   Set ReferenceBlocPlancher = InsererBloc(Range("A17"), PositionBlocPlancher)
   BlocDecompose = ReferenceBlocPlancher.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocPlancher.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B17"), (Range("C17")))      'Visibilité1

   End If
   
   '--Bloc Plancher polystyrène pour soubassement d'épaisseur 25cm--'
   
   If Worksheets("BlocsDynVBA").Range("Q18") = "Oui" Then
   
   PositionBlocPlancher(0) = 0#
   PositionBlocPlancher(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR"))
   PositionBlocPlancher(2) = 0#
   
   Set ReferenceBlocPlancher = InsererBloc(Range("A18"), PositionBlocPlancher)
   BlocDecompose = ReferenceBlocPlancher.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocPlancher.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B18"), (Range("C18")))      'Visibilité1

   End If

   '--Bloc Plancher polystyrène pour soubassement d'épaisseur 27.5cm--'
   
   If Worksheets("BlocsDynVBA").Range("Q19") = "Oui" Then
   
   PositionBlocPlancher(0) = 0#
   PositionBlocPlancher(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR"))
   PositionBlocPlancher(2) = 0#

   Set ReferenceBlocPlancher = InsererBloc(Range("A19"), PositionBlocPlancher)
   BlocDecompose = ReferenceBlocPlancher.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocPlancher.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B19"), (Range("C19")))      'Visibilité1

   End If

   '--Bloc Plancher polystyrène pour soubassement d'épaisseur 30cm--'
   
   If Worksheets("BlocsDynVBA").Range("Q20") = "Oui" Then
   
   PositionBlocPlancher(0) = 0#
   PositionBlocPlancher(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR"))
   PositionBlocPlancher(2) = 0#

   Set ReferenceBlocPlancher = InsererBloc(Range("A20"), PositionBlocPlancher)
   BlocDecompose = ReferenceBlocPlancher.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocPlancher.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B20"), (Range("C20")))      'Visibilité1

   End If
   
'''''BLOCS PLANCHER HAUT VIDE SANITAIRE BETON''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

   '--Bloc Plancher béton pour soubassement d'épaisseur 20cm--'
   
   If Worksheets("BlocsDynVBA").Range("Q23") = "Oui" Then
   
   PositionBlocPlancher(0) = 0#
   PositionBlocPlancher(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR"))
   PositionBlocPlancher(2) = 0#

   Set ReferenceBlocPlancher = InsererBloc(Range("A23"), PositionBlocPlancher)
   BlocDecompose = ReferenceBlocPlancher.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocPlancher.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B23"), (Range("C23")))      'Visibilité1

   End If
   
   '--Bloc Plancher béton pour soubassement d'épaisseur 25cm--'
   
    If Worksheets("BlocsDynVBA").Range("Q24") = "Oui" Then
   
   PositionBlocPlancher(0) = 0#
   PositionBlocPlancher(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR"))
   PositionBlocPlancher(2) = 0#

   Set ReferenceBlocPlancher = InsererBloc(Range("A24"), PositionBlocPlancher)
   BlocDecompose = ReferenceBlocPlancher.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocPlancher.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B24"), (Range("C24")))      'Visibilité1

   End If
   
   '--Bloc Plancher béton pour soubassement d'épaisseur 27.5cm--'
   
   If Worksheets("BlocsDynVBA").Range("Q25") = "Oui" Then
   
   PositionBlocPlancher(0) = 0#
   PositionBlocPlancher(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR"))
   PositionBlocPlancher(2) = 0#
   
   Set ReferenceBlocPlancher = InsererBloc(Range("A25"), PositionBlocPlancher)
   BlocDecompose = ReferenceBlocPlancher.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocPlancher.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B25"), (Range("C25")))      'Visibilité1

   End If
   
   '--Bloc Plancher béton pour soubassement d'épaisseur 30cm--'
   
   If Worksheets("BlocsDynVBA").Range("Q26") = "Oui" Then
   
   PositionBlocPlancher(0) = 0#
   PositionBlocPlancher(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR"))
   PositionBlocPlancher(2) = 0#

   Set ReferenceBlocPlancher = InsererBloc(Range("A26"), PositionBlocPlancher)
   BlocDecompose = ReferenceBlocPlancher.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocPlancher.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B26"), (Range("C26")))      'Visibilité1

   End If

''''BLOCS PLANCHER HAUT VIDE SANITAIRE ACOUSTIQUE''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

   '--Bloc Plancher acoustique pour soubassement d'épaisseur 20cm--'
   
   If Worksheets("BlocsDynVBA").Range("Q29") = "Oui" Then
   
   PositionBlocPlancher(0) = 0#
   PositionBlocPlancher(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR"))
   PositionBlocPlancher(2) = 0#
   
   Set ReferenceBlocPlancher = InsererBloc(Range("A29"), PositionBlocPlancher)
   BlocDecompose = ReferenceBlocPlancher.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocPlancher.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B29"), (Range("C29")))      'Visibilité1

   End If

   '--Bloc Plancher acoustique pour soubassement d'épaisseur 25cm--'
   
   If Worksheets("BlocsDynVBA").Range("Q30") = "Oui" Then
   
   PositionBlocPlancher(0) = 0#
   PositionBlocPlancher(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR"))
   PositionBlocPlancher(2) = 0#
  
   Set ReferenceBlocPlancher = InsererBloc(Range("A30"), PositionBlocPlancher)
   BlocDecompose = ReferenceBlocPlancher.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocPlancher.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B30"), (Range("C30")))      'Visibilité1

   End If

   '--Bloc Plancher acoustique pour soubassement d'épaisseur 27.5cm--'
   
   If Worksheets("BlocsDynVBA").Range("Q31") = "Oui" Then
   
   PositionBlocPlancher(0) = 0#
   PositionBlocPlancher(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR"))
   PositionBlocPlancher(2) = 0#

   Set ReferenceBlocPlancher = InsererBloc(Range("A31"), PositionBlocPlancher)
   BlocDecompose = ReferenceBlocPlancher.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocPlancher.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B31"), (Range("C31")))      'Visibilité
   
   End If
   
   '--Bloc Plancher acoustique pour soubassement d'épaisseur 30cm--'
   
   If Worksheets("BlocsDynVBA").Range("Q32") = "Oui" Then
   
   PositionBlocPlancher(0) = 0#
   PositionBlocPlancher(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR"))
   PositionBlocPlancher(2) = 0#
  
   Set ReferenceBlocPlancher = InsererBloc(Range("A32"), PositionBlocPlancher)
   BlocDecompose = ReferenceBlocPlancher.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocPlancher.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B32"), (Range("C32")))      'Visibilité1

   End If
  
''''BLOCS VOILES ELEVATION'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
   '--Bloc agglos à bancher d'elévation RdC--'
   
   If Worksheets("BlocsDynVBA").Range("Q35") = "Oui" Then
   
   PositionBlocElevation(0) = 0#
   PositionBlocElevation(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR")) + CDbl(Range("HTPHVS"))
   PositionBlocElevation(2) = 0#
   
   Set ReferenceBlocElevation = InsererBloc(Range("A35"), PositionBlocElevation)
   BlocDecompose = ReferenceBlocElevation.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocElevation.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B35"), CDbl(Range("C35")))  'nb_rangs
   Call ChangerParametreDynamique(ReferenceBloc2, Range("D35"), (Range("E35")))      'Visibilité1

   End If
   
   '--Bloc agglos creux d'elévation RdC--'
   
   If Worksheets("BlocsDynVBA").Range("Q36") = "Oui" Then
   
   PositionBlocElevation(0) = 0#
   PositionBlocElevation(1) = CDbl(Range("HAUTEURSEMELLE")) + CDbl(Range("HTSOUB")) + CDbl(Range("HTAR")) + CDbl(Range("HTPHVS"))
   PositionBlocElevation(2) = 0#
     
   Set ReferenceBlocElevation = InsererBloc(Range("A36"), PositionBlocElevation)
   BlocDecompose = ReferenceBlocElevation.Explode
   Set ReferenceBloc2 = BlocDecompose(0)
   ReferenceBlocElevation.Delete
   Call ChangerParametreDynamique(ReferenceBloc2, Range("B36"), CDbl(Range("C36")))  'nb_rangs
   Call ChangerParametreDynamique(ReferenceBloc2, Range("D36"), (Range("E36")))      'Visibilité1

   End If
    
   AcadObj.ZoomExtents
   'AcadObj.Regen
   TerminerExport
    
   Dim Msg As String
   Msg = MsgBox("Souhaitez-vous dessiner une autre vue de détails?", vbYesNo)
   
   If Msg = vbYes Then
       JJ = 297 + JJ
           UserForm1.Show
       Else: Unload UserForm1
   End If
    
End Sub

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité