GOLUM69

C'est ça exactement, je l'explose avant le lissage Oui c'est le coeur de mon problème, l'angle est variable et je ne sais comment m'y prendre .. Maisla fonction lissage, permet de choisir plusieurs profil mais pas de suivre un chemin ?

Merci pbrion pour tes réponses. ;) Du coup je viens de m'apercevoir, que la fonction balayage permet de suivre un chemin mais ne me permet pas de sélectionner deux profils différents pour la modélisation 3d. Donc je pense que la seul fonction 3d qui me permette ça c'est lissage. Mais du coup pour la fonction lissage on en revient au même problème car il faut que je place mes profils à la perpendiculaire de la pol 3d.

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

Oui c'est ce que j'ai fais mais en faisant le balayage le profil s'inverse.

Oui je me suis surement trompé..j'ai bien une version complète d'autocad. J'ai essayé le balayage, j'ai mis mon point de base sur le point d'extrémité de ma polyligne 3d, cependant mon solide 3d se dessine à l'envers. J'ai essayé avec la commande rotation mais il faut que je modifie mon scu pour pouvoir le faire. J'ai vu qu'en modifiant dans les propriétés de l'objet, je peux mettre un angle de rotation mais je ne sais pas accéder à la boite de propriété en lisp.

Bonjour à tous, Je travaille dans une entreprise de travaux publics et nous utilisons principalement Autocad et Covadis. On m'a demandé de modéliser en 3D des bordures suivant une polyligne 3d. Pour se faire; j'ai créer mes blocs formant le profil de ma bordure sur un plan xy. Je souhaiterai ainsi pouvoir insérer en fonction de la bordure, le profil adapté sur une point de la polyligne 3d. Puis faire une rotation 3d pour que mon profil soit à la perpendiculaire de ma polyligne 3d. Je souhaiterai avoir le choix de faire un miroir afin de la tourner de l'autre coté suivant le coté de la voirie. Et pouvoir l'extruder avec la fonction balayage entre les profils précédemment insérés. Rendu final (image1). J'aimerai créer un lisp, me permettant d'exécuter la fonction décrite précédemment. J'ai commencé mon lisp, cependant je suis resté bloquer sur la rotation 3d. En espérant que quelqu’un pourra m'aider. Merci par avance. (defun c:bordure3d () (initget "T1 T2 T3 T4") (setq REP (getkword "\nType de bordure [T1/T2/T3/T4] <T2> : ")) (setq p(getpoint "\nPoint d'insertion de la bordure :")) (cond ((= Rep "T1") (command "-inserer" "bordureT1" p 1 1 0)) ((= Rep "T2") (command "-inserer" "bordureT2" p 1 1 0)) ((= Rep "T3") (command "-inserer" "bordureT3" p 1 1 0)) ((= Rep "T4") (command "-inserer" "bordureT4" p 1 1 0)) )

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

Merci beaucoup DenisHen !! et dis moi saurais tu comment faire pour récupérer l'aire de la polyligne et que cela affiche l'aire en texte selon le point ou l'on clique ? Thanks you d'avance ..

Bonsoir a tous, je revient vers vous car j'ai encore un petit problème que je n'arrive pas a résoudre. Je voudrais créer un programme permettant de créer des zones de stockages pour un plan d'installation de chantier. Le programme consisterais à demander à l'utilisateur de sélectionner plusieurs points sur le plan puis une fois qu'il appui sur return, la polyligne se ferme. (car dans mon début de programme, ci après, quand je met "c" a la fin de la commande cela ne fonctionne pas) puis de récupérer l'aire de la polyligne crée et de l'afficher en texte, centré au milieu de la zone. J'ai malheureusement de très grosses lacunes en codes DXF, je ne sais pas trop les manipulés. C'est pour quoi j'implore grandement votre aide !!! :( :( :( VOICI LE DEBUT DE MON CODE (tout pourri :( ) : (defun c:ZoneStockage() (setq pt(getpoint "\nPoint d'origine: ")) (command "polylign" pt "la" 0 0 "c") (while pt (setq pt (getpoint "\nPoint suivant(Return pour FIN): ")) (command pt)) )

Merci beaucoup Zebulon_ !!! c'était exactement sa le problème sa marche très bien maintenant. DenisHen , j'utilise Visual LISP (commande "VLIDE"), les caractères étranges doivent être dus au fait de passer de windows à OS je pense... je travaille simultanément sur PC et sur Mac (mauvaise compatibilité malheureusement) Merci beaucoup à vous deux en tout cas !!

Bonjour a tous, je suis débutant en LISP et j'ai crée un code qui permet d'insérer une grue sur un plan d'installation de chantier. Mon programme demande à l'utilisateur s'il désire implanter une grue fixe ou mobile. Je l'ai donc paramétrer avec la fonction Initget et getkword, ensuite j'ai créer les programmes pour les deux types de grues. Quand je lance la commande dans autocad cela me demande le choix entre les deux mais après le programme plante et ne veut pas s'exécuter après que l'utilisateur est choisit le type de grue. Je suis vraiment bloquer je ne trouve pas la solution au problème, j'implore votre aide !! Thank you !! VOICI MON PROGRAMME: (defun Fixe() (setq rep "Fixe") (setq P1 (getpoint "\nCliquez sur le point d'implantation de la grue fixe :")) (setq P2 (getpoint "\nLongueur de la flËche :")) (setq F (distance P1 P2)) (setq P3 (polar P1 (- alfa (/ pi 2)) F)) (command "cercle" P1 P2) (command "-inserer" "G_Bloc" P1 1 1 0) ) (defun Mobile() (setq rep "Mobile") (setq A (getpoint "\nCliquez sur le point de dÈpart du rail :")) (setq L (getdist "\nLongeur du rail :")) (setq alfa (getangle "\nAngle d'implantation du rail :")) (setq F (getdist "\nLongueur de la flËche :")) (setq B (polar A alfa L)) (setq A1 (polar A (- alfa (/ pi 2)) F)) (setq B1 (polar A1 alfa L)) (setq A2 (polar A (+ (/ pi 2) alfa) F)) (setq B2 (polar A2 alfa L)) (command "ligne" A B "") (command "polylign" A1 B1 "A" "R" F B2 "Li" A2 "A" "R" F A1 "cl") ) (defun c:Grue() ;; initialiser les options (initget 1 "Fixe Mobile") ;; inviter l'utilisateur ‡ choisir une option (setq Rep (getkword "\nType de grue ? [Fixe/Mobile]")) (cond (= Rep "Fixe")(Fixe) (= Rep "Mobile")(Mobile) ) )