robine

Bonjour Vincent, Est ce que tu pourrais me donner tes solutions de traitement stp ? 🙂

Merci Vincent pour ton retour. Pour le fin mot de l'histoire, j'ai appelé Mensura et d'après eux, ça serait un bug qui serait résolue dans la future prochaine version. Donc on patiente 🙂 Bonne journée !

Bonjour à tous, J'ai un problème récurent lorsque j'exporte vers autocad depuis mensura. Systématiquement, je me retrouve avec un doublon de blocs ( étiquettes ou cotations sous mensura) superposés mais avec un nom de bloc différent … Petit exemple : Quelqu'un aurait la solution svp ? Merci d'avance 🙂

Il faut aller modifier le fichier PlatformCodes.xml qui se trouve dans Bases FRANCE-FR\3D Surfaces. Une fois que c'est fait, on lance charger en bas à gauche de la fenêtre code surfaces projet dans le module Surfaces Projet.

Merci pour votre "accompagnement" sous forme de "questions constructives et sympathiques" qui a rendu cet échange pas très agréable mais j'ai finalement trouvé comment faire et ça marche très bien.

Désolé, je suis en effet partie dans tous les sens 😁 Je cherche juste a savoir si il est possible d'éviter de passer par nouveau code dans codes surface projet pour créer un nouveau code. Est ce qu'il existe une autre façon de le faire comme de créer une liste de nouveau code sur Excel par exemple comme il est possible de faire sur Autocad ?

coucou la team ! Pour un projet avec un énorme découpage de zones, une quarantaine de zones pour les métrés 😔 ..., je cherche une technique pour anticiper ce découpage qui se fait souvent à la fin quand on plus de temps et qui devient une usine à gaz ... J'aimerai attribuer des codes par zone ' exemple : Z1-Enrobé, Z1-Trottoir etc .... mais c'est assez fastidieux surtout dans mensura où les fenêtres ne sont pas tj extensible et maniable, bref ! Est ce qu'il existe une technique pour créer à la chaîne cette liste de code via Excel ou autre ? merci et bonne journée 🙂

Salut, Merci beaucoup pour la manip! Je cherchais surtout pour les lignes d'arêtes dans le module surface projet mais le process est assez similaire. J'ai fait un test sur une plateforme simple, ça marche bien. A tester sur un projet + complexe. Merci Erased

Bonjour à tous, Je remonte le sujet pour savoir si quelqu'un aurait une solution aujourd'hui 🙂

Merci @lecrabe !!

Merci pour ton retour 🙂 C'est pas forcement la solution à laquelle je pensais mais elle fait très bien le travail !! Très intéressant également le Lisp pour extraire la liste des propriétés. Est ce que tu sais comment repartir de cette liste "excel" pour automatiser les propriétés personnalisées du dessin ? en gros faire le chemin inverse Encore merci pour la solution

Bonjour à tous, J'ai une petite problématique et je voudrai avoir vos avis sur ce sujet. J'ai créé un bloc cartouche avec tous les attributs qui vont bien et j'aimerai lier ses attributs dans les pages suivantes qu'on retrouvera dans un bandeau en bas de la page avec la commande Gatte ou autre. Par exemple : le titre du document, les dates des modifications et observations etc .... j'ai essayé les champs ( sans grand succès ... peut être mal utilisé par mes soins). J'ai trouvé un lisp LATT qui lie les attributs entre eux ( ça marche très bien) mais la fonction ne marche plus à la fermeture du dwg. Est ce qu'il existe une solution ou sinon je me résous à changer les attributs 2 fois, une fois dans le cartouche principal et une fois pour les pages avec bandeau. Merci à tous et bonne journée 🙂

Voila le lien (le fichier dvb et la copie d'écran) : https://we.tl/t-5ixQ829nUo

oui oui

Tu exécutes ton projet VBA dans AutoCAD ? oui Quelle est ta version d'AutoCAD ? Autocad 2018 Peux-tu nous transmettre ton projet VBA (fichier .DVB pour AutoCAD) ? Ton projet VBA utilise Excel ? oui Je n'arrive pas a le mettre en PJ (pb d'erreur du serveur), alors le voici : Sub Métrés() Dim i, j, NbrBlocs, NbrPlignes, NbrLwPlines, NbrObjets As Double Dim Largeur, Echelle, Couleur, Nbr, Longueur, Surface As Variant Dim NomCalque, NomObjet, NomBloc, TypeTrait As String Dim Bloc As AcadBlockReference Dim L() As Variant Dim objet As AcadObject Dim Selection As AcadSelectionSet Dim Coord As Variant On Error Resume Next ThisDrawing.SelectionSets("SEL").Delete Set Selection = ThisDrawing.SelectionSets.Add("SEL") Selection.SelectOnScreen NbrObjets = Selection.Count ReDim L(NbrObjets, 10) L(0, 1) = 0 For Each objet In Selection NomCalque = objet.Layer If Len(NomCalque) = 1 Then NomCalque = "Layer " & NomCalque NomObjet = objet.ObjectName If NomObjet = "AcDbBlockReference" Then NomObjet = "Bloc" Set Bloc = objet NomBloc = Bloc.Name If Left(NomBloc, 1) <> "*" Then j = L(0, 1) + 1 For i = 1 To j If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1 If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 2) = NomBloc)) Then L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 2) = NomBloc L(i, 7) = L(i, 7) + 1 i = j End If Next i End If End If If NomObjet = "AcDbBlock" Then NomObjet = "Bloc" Set Bloc = objet NomBloc = Bloc.Name If Left(NomBloc, 1) <> "*" Then j = L(0, 1) + 1 For i = 1 To j If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1 If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 2) = NomBloc)) Then L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 2) = NomBloc L(i, 7) = L(i, 7) + 1 i = j End If Next i End If End If If NomObjet = "AcDbLWPolyline" Then NomObjet = "Pline" NomBloc = "" TypeTrait = objet.Linetype Largeur = objet.Lineweight Echelle = objet.LinetypeScale Couleur = objet.color Longueur = objet.Length If objet.Closed Then Surface = objet.Area Else Surface = 0 j = L(0, 1) + 1 For i = 1 To j If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1 If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface If Surface <> 0 Then L(i, 10) = L(i, 10) + 1 i = j End If Next i End If If NomObjet = "AcDbPolyline" Then NomBloc = "" NomObjet = "Pline" TypeTrait = objet.Linetype Largeur = objet.ConstantWidth Echelle = objet.LinetypeScale Couleur = objet.color Longueur = objet.Length Surface = objet.Area If objet.Closed Then Surface = objet.Area Else Surface = 0 j = L(0, 1) + 1 For i = 1 To j If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1 If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface If Surface <> 0 Then L(i, 10) = L(i, 10) + 1 i = j End If Next i End If If NomObjet = "AcDb2dPolyline" Then NomBloc = "" NomObjet = "SpLine" TypeTrait = objet.Linetype Largeur = objet.ConstantWidth Echelle = objet.LinetypeScale Couleur = objet.color Longueur = objet.Length If objet.Closed Then Surface = objet.Area Else Surface = 0 j = L(0, 1) + 1 For i = 1 To j If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1 If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface If Surface <> 0 Then L(i, 10) = L(i, 10) + 1 i = j End If Next i End If If NomObjet = "AcDbMline" Then NomBloc = "" NomObjet = "MLine" TypeTrait = objet.Linetype Largeur = objet.ConstantWidth Echelle = objet.LinetypeScale Couleur = objet.color Longueur = objet.Length If objet.Closed Then Surface = objet.Area Else Surface = 0 j = L(0, 1) + 1 For i = 1 To j If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1 If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur 'L(i, 9) = L(i, 9) + Surface 'If Surface <> 0 Then L(i, 10) = L(i, 10) + 1 i = j End If Next i End If If NomObjet = "AcDbCircle" Then NomBloc = "" NomObjet = "Cercle" TypeTrait = objet.Linetype Largeur = objet.ConstantWidth Echelle = objet.LinetypeScale Couleur = objet.color Longueur = objet.Length Surface = objet.Area j = L(0, 1) + 1 For i = 1 To j If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1 If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface i = j End If Next i End If If NomObjet = "AcDbArc" Then NomBloc = "" NomObjet = "Arc" TypeTrait = objet.Linetype Largeur = objet.ConstantWidth Echelle = objet.LinetypeScale Couleur = objet.color Longueur = objet.Length Surface = objet.Area j = L(0, 1) + 1 For i = 1 To j If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1 If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface i = j End If Next i End If If NomObjet = "AcDbEllipse" Then NomBloc = "" NomObjet = "Ellipse" TypeTrait = objet.Linetype Largeur = objet.ConstantWidth Echelle = objet.LinetypeScale Couleur = objet.color Longueur = objet.Length Surface = objet.Area j = L(0, 1) + 1 For i = 1 To j If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1 If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = NomObjet And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then L(i, 0) = NomCalque: L(i, 1) = NomObjet: L(i, 3) = TypeTrait L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface i = j End If Next i End If If NomObjet = "AcDbLine" Then NomBloc = "" TypeTrait = objet.Linetype Largeur = objet.Lineweight Echelle = objet.LinetypeScale Couleur = objet.color Longueur = objet.Length Surface = 0 j = L(0, 1) + 1 For i = 1 To j If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1 If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = "Line" And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then L(i, 0) = NomCalque: L(i, 1) = "Line": L(i, 3) = TypeTrait L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur i = j End If Next i End If If NomObjet = "AcDbAlignedDimension" Then NomBloc = objet.TextPrefix TypeTrait = objet.Linetype Largeur = objet.Lineweight / 100 Echelle = objet.LinetypeScale Couleur = objet.color Longueur = objet.Measurement Surface = 0 j = L(0, 1) + 1 For i = 1 To j If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1 If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = "Cote" And L(i, 2) = NomBloc And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then L(i, 0) = NomCalque: L(i, 1) = "Cote": L(i, 2) = NomBloc: L(i, 3) = TypeTrait L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur L(i, 7) = L(i, 7) + 1: L(i, 8) = L(i, 8) + Longueur: L(i, 9) = L(i, 9) + Surface If Surface <> 0 Then L(i, 10) = L(i, 10) + 1 i = j End If Next i End If If NomObjet = "AcDbHatch" Then NomBloc = "" TypeTrait = objet.PatternName Largeur = objet.Lineweight Echelle = objet.PatternScale Couleur = objet.color Longueur = 0 Surface = 0 j = L(0, 1) + 1 For i = 1 To j If L(i, 0) = "" Then L(0, 1) = L(0, 1) + 1 If (L(i, 0) = "" Or (L(i, 0) = NomCalque And L(i, 1) = "Hachure" And L(i, 3) = TypeTrait And L(i, 4) = Largeur And L(i, 5) = Echelle And L(i, 6) = Couleur)) Then L(i, 0) = NomCalque: L(i, 1) = "Hachure": L(i, 3) = TypeTrait L(i, 4) = Largeur: L(i, 5) = Echelle: L(i, 6) = Couleur L(i, 7) = L(i, 7) + 1: L(i, 9) = L(i, 9) + Surface If Surface <> 0 Then L(i, 10) = L(i, 10) + 1 i = j End If Next i End If Next Set xl = CreateObject("Excel.Application") xl.Visible = True Set Classeur = xl.workbooks.Add Set feuille = xl.worksheets(1) feuille.Name = "métrés" With feuille.Range("A1:K1") .Font.Name = "Arial" .Font.Size = 10 .Font.Bold = True End With With feuille.cells(1, 1) .Value = "Nom" & vbLf & "Couche" End With feuille.cells(1, 2) = "Nom" & vbLf & "Objet" feuille.cells(1, 3) = "Nom" & vbLf & "Bloc" feuille.cells(1, 4) = "Type" & vbLf & "Trait" feuille.cells(1, 5) = "Largeur" feuille.cells(1, 6) = "Echelle" feuille.cells(1, 7) = "Couleur" feuille.cells(1, 8) = "Nombre" & vbLf & "Total" feuille.cells(1, 9) = "Longueur" & vbLf & "Totale" feuille.cells(1, 10) = "Surface" & vbLf & "Totale" feuille.cells(1, 11) = "Contrôle" & vbLf & "Surface" For i = 1 To L(0, 1) For j = 0 To 10 feuille.cells(i + 1, j + 1) = L(i, j) Next j Next i End Sub