g_barthe

Bonjour à tous, Je cherche désespérément le bloc d'une bouche de VMC type BAP ou autoréglable qui puisse être paramétrer par autocad mep. C'est tout con mais on l'utilise souvent cette petite bouche et pas moyen d'avoir ça en librairie. Si l'un d'entre vous aurait cela ? J'ai jeté un œil sur autodesk seek mais par trouvé mon bonheur. Merci à tous.

Bonjour, Je suis un "habitué" d'autocad mais je souhaitais passer au MEP. Seulement j'ai du mal à trouver des tutos. Et la gestion des projets n'est pas clairement expliqué je trouve. Avez-vous des infos sur des tutos, didacticiels français de préférences qui serait bien fait. Merci à tous.

Pour le coup de la région j'en étais arrivé à la même conclusion. Et l'utilité est juste pour trouver le centroid afin de positionner le texte. Donc je vais peut être récupérer le centroid et virer la région pour utiliser la polyligne. A voir. Oui pour le moment le seul point noir c'est la confirmation après chaque point pour savoir si on en veut un autre ou non. Dommage. Tu n'as pas de hachures ???? peut être un pb d'échelle des hachures non ? Je suis déjà rassuré que ça marche pour toi.

Salut Merci du compliment Je pense que ton pb est lié à la forme de ta polyligne. Il faut que les points que tu as saisis soit dans un ordre qui permette de faire des formes sans croisement de segments. En fait un truc qui va delimiter une region. euh pas facile a expliquer. Le mieux est que tu essaie en faisant un rectangle coté par coté en tournant dans un sens. Dis moi si tu as pigé ce que je dis pck pas clair peut être. Je pense que ton pb vient de la forme que tu cherche à dessiner. PS : j'ai testé sous 2006 et MEP 2008 donc normalement ça doit le faire mais pas à l'abri d'une c.... ;)

Re bonjour, Alors voici la version finalisée du programme. Sub plan_reperage() ' Déclaration des variables Dim returnObj As AcadObject Dim returnPnt(0 To 2) As Double Dim basePnt As Variant Dim code As String Dim texte As String Dim largeur_mini, largeur_texte, largeur As Double Dim Htxt As Double Dim objMtext As AcadMText Dim a As String Dim rapport As Double Dim Reponse, echelle_du_plan As String Dim vertices() As Double Dim pnt As Variant Dim i, j As Integer Dim polyObj As AcadPolyline Dim toto, titi As String Dim layerObj As AcadLayer Dim texteref As AcadObject Dim Centroid, region As Variant Dim region2 As Variant Dim region_element(0) As AcadEntity Dim region_element2(0) As AcadEntity Dim boxObj As AcadRegion Dim boxObj2 As AcadRegion Dim hatchObj As AcadHatch Dim patternName As String Dim PatternType As Long Dim bAssociativity As Boolean Dim EchelleHachure As Double Dim echelle, unite As String Dim Value1 As String Dim type_entite As String Dim espacement_entre_lignes As Double Dim currInsertionPoint As Variant Dim vertices1(0 To 11) As Double Dim version As String Dim Msg, Style, Title, Response ' Récupération de la version pour éviter les erreurs sur les anciennes versions version = ThisDrawing.Application.version version = Left(version, 4) If version >= "16.2" Then ' si la version est antérieure à Autocad 2006 on n'exécute pas le programme ' Creation du calque repérage de couleur magenta Set layerObj = ThisDrawing.Layers.Add("Repérage") layerObj.color = acMagenta ThisDrawing.ActiveLayer = layerObj ' Verification si l'unite du dessin a deja été définie If (ThisDrawing.SummaryInfo.NumCustomInfo >= 1) Then ThisDrawing.SummaryInfo.GetCustomByKey "unite", Value1 Select Case Value1 Case "m" rapport = 1 Case "cm" rapport = 0.0001 Case "mm" rapport = 0.000001 End Select Else echelle_du_plan = ThisDrawing.Utility.GetString(False, "Echelle du plan C, M, MM (Taper pour valider): ") Select Case echelle_du_plan Case "m", "M" unite = "m" rapport = 1 Case "c", "C" unite = "cm" rapport = 0.0001 Case "mm", "MM" unite = "mm" rapport = 0.000001 End Select ThisDrawing.SummaryInfo.AddCustomInfo "unite", unite End If ' Selection d'un texte du dessin pour récupérer les hauteurs de texte du dessin ThisDrawing.Utility.GetEntity texteref, basePnt, "Sélectionner un texte pour définir la hauteur : " type_entite = texteref.EntityName Select Case type_entite ' Cas d'un texte normal Case "AcDbText" Htxt = texteref.height Case "AcDbMText" ' Cas d'un texte multiligne Htxt = texteref.height Case "AcDbBlockReference" ' Cas d'un texte dans un attribut de bloc Dim varAttributes As Variant varAttributes = texteref.GetAttributes Htxt = varAttributes(0).height End Select largeur_mini = 7 * Htxt ' Initialisation des variables i = 0 j = 0 k = 0 a = "Oui" ReDim vertices(0 To 1000) ' Redimensionnement du tableau de points ' Boucle pour saisir plusieurs points pour la polyligne While (a = "Oui") pnt = ThisDrawing.Utility.GetPoint(, "Sélectionner un point ? ") j = i + 1 k = j + 1 vertices(i) = pnt(0): vertices(j) = pnt(1): vertices(k) = pnt(2) Reponse = ThisDrawing.Utility.GetString(False, "Autre point Oui ou Non (Taper pour valider): ") Select Case Reponse Case "o", "O" a = "Oui" Case "n", "N" a = "Non" End Select j = i + 1 k = j + 1 i = k + 1 Wend ReDim Preserve vertices(0 To k) ' Redimensionnement du tableau de points en fonction de nombre de points réels ' Dessin de la polyligne Set polyObj = ThisDrawing.ModelSpace.AddPolyline(vertices) polyObj.Closed = True ' Création de la région Set region_element(0) = polyObj region = ThisDrawing.ModelSpace.AddRegion(region_element) ' Transformation de la region Variant en objet region pour après trouver le centre Set boxObj = region(0) ' Le point de base du texte est le centre de la region Centroid = boxObj.Centroid returnPnt(0) = Centroid(0): returnPnt(1) = Centroid(1): returnPnt(2) = 0 ' Saisie au prompt du code du local code = ThisDrawing.Utility.GetString(True, "Code du local (Taper pour valider): ") ' Operations pour définir une largeur de texte cohérente avec la longueur du texte largeur_texte = Len(code) * Htxt If largeur_texte > largeur_mini Then largeur = largeur_texte Else largeur = largeur_mini End If ' Création du texte avec le code du local et sur la ligne en dessous la surface arrondi 0.00 toto = boxObj.ObjectID ' recup de l'ID de la region echelle = "ct8[" & rapport & "]" titi = "" & "\f " & Chr(34) & Chr(37) & "lu2" & Chr(37) & "pr2" & Chr(37) & echelle & Chr(34) & "" texte = code & vbCrLf & "%<\AcObjProp Object(%<\_ObjId " & toto & ">%).Area " & titi & ">%" & " m\U+00B2" ' concatenation champs + code local Set objMtexte = ThisDrawing.ModelSpace.AddMText(returnPnt, largeur, texte) espacement_entre_lignes = 1.5 * Htxt objMtexte.height = Htxt currInsertionPoint = objMtexte.InsertionPoint objMtexte.AttachmentPoint = acAttachmentPointMiddleCenter ' Coordonnées de la polyligne liée au texte vertices1(0) = currInsertionPoint(0): vertices1(1) = currInsertionPoint(1): vertices1(2) = currInsertionPoint(2) vertices1(3) = currInsertionPoint(0) + largeur: vertices1(4) = currInsertionPoint(1): vertices1(5) = currInsertionPoint(2) vertices1(6) = currInsertionPoint(0) + largeur: vertices1(7) = currInsertionPoint(1) - espacement_entre_lignes - 2 * Htxt: vertices1(8) = currInsertionPoint(2) vertices1(9) = currInsertionPoint(0): vertices1(10) = currInsertionPoint(1) - espacement_entre_lignes - 2 * Htxt: vertices1(11) = currInsertionPoint(2) ' Dessin de la polyligne liée au texte Set polyObj2 = ThisDrawing.ModelSpace.AddPolyline(vertices1) polyObj2.Closed = True ' Création de la région liée au texte Set region_element2(0) = polyObj2 region2 = ThisDrawing.ModelSpace.AddRegion(region_element2) ' Creation des hachures dans la region patternName = "ANSI31" PatternType = acPreDefinedGradient bAssociativity = True EchelleHachure = Htxt / 2 Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity) hatchObj.AppendOuterLoop (region) hatchObj.PatternScale = EchelleHachure ' Suppression des hachures dans la region liée au texte hatchObj.AppendInnerLoop (region2) ' Actualisation du dessin et des hachures hatchObj.Evaluate ThisDrawing.Regen True ' Suppression de la polyligne sinon doublon avec la region créée polyObj.Delete polyObj2.Delete Else Msg = "Votre version d'Autocad n'est pas compatible avec ce programme. Une version plus récente est nécessaire" Style = vbOK + vbCritical Title = "Incompatibilité de version" Response = MsgBox(Msg, Style, Title) End If End Sub J'ai mis en téléchargement le fichier dvb ainsi qu'une documentation en format doc ici : http://pausebroderie.fr/taz_genie_climatique/plans_reperages.zip N'hésitez pas à me rapporter des bugs, idées d'améliorations...

je finalise un truc sur la gestion des version d'autocad et je fais un mode d'emploi c'est prévu et c'est en cours @tte

je suis en train de finaliser avec le coup des hachures la version devrait venir dans la journée. Je dois aussi tester la version sur le poste qui fait tourner le prog vu que j'utilise les champs et que les versions plus anciennes n'ont pas forcément cette fonctionnalité je testerais au cas où. Ton pb est bizarre car tu pourrais avoir une erreur si tu ne sélectionne pas de texte au début pour choisir la hauteur en cas de clic dans le vide par exemple. Mais la c'est quand tu choisis tes poins c'est ça ?

Bonjour à tous, Alors voici une mise à jour du programme. Je gère maintenant l'unité dans laquelle le dessin a été fait et je la rajoute dans les propriétés du fichier. Plus besoin de choisir la polyligne que l'on vient de dessiner pour en sortir la surface. Ajout je l'unité au bout du champs surface. Voilà des améliorations qui permettent un meilleur confort d'utilisation. Il me reste à trouver pour hachurer la région en excluant la texte des hachures et à permettre à l'utilisateur de saisir ses points pour la polyligne sans avoir à dire oui je veux un nouveau point. Mais là déjà c'est plus agréable je trouve. Sub plan_reperage() ' Déclaration des variables Dim returnObj As AcadObject Dim returnPnt(0 To 2) As Double Dim basePnt As Variant Dim code As String Dim texte As String Dim largeur_mini, largeur_texte, largeur As Double Dim Htxt As Double Dim objMtext As AcadMText Dim a As String Dim rapport As Double Dim Reponse, echelle_du_plan As String Dim vertices() As Double Dim pnt As Variant Dim i, j As Integer Dim polyObj As AcadPolyline Dim toto, titi As String Dim layerObj As AcadLayer Dim texteref As AcadObject Dim Centroid, region As Variant Dim region_element(0) As AcadEntity Dim boxObj As AcadRegion Dim hatchObj As AcadHatch Dim patternName As String Dim PatternType As Long Dim bAssociativity As Boolean Dim EchelleHachure As Double Dim echelle, unite As String Dim Value1 As String Dim type_entite As String ' Creation du calque repérage de couleur magenta Set layerObj = ThisDrawing.Layers.Add("Repérage") layerObj.color = acMagenta ThisDrawing.ActiveLayer = layerObj ' Verification si l'unite du dessin a deja été définie If (ThisDrawing.SummaryInfo.NumCustomInfo >= 1) Then ThisDrawing.SummaryInfo.GetCustomByKey "unite", Value1 Select Case Value1 Case "m" rapport = 1 Case "cm" rapport = 0.0001 Case "mm" rapport = 0.000001 End Select Else echelle_du_plan = ThisDrawing.Utility.GetString(False, "Echelle du plan C, M, MM (Taper pour valider): ") Select Case echelle_du_plan Case "m", "M" unite = "m" Case "c", "C" unite = "cm" Case "mm", "MM" unite = "mm" End Select ThisDrawing.SummaryInfo.AddCustomInfo "unite", unite End If ' Selection d'un texte du dessin pour récupérer les hauteurs de texte du dessin ThisDrawing.Utility.GetEntity texteref, basePnt, "Sélectionner un texte pour définir la hauteur : " type_entite = texteref.EntityName Select Case type_entite ' Cas d'un texte normal Case "AcDbText" Htxt = texteref.height Case "AcDbMText" ' Cas d'un texte multiligne Htxt = texteref.height Case "AcDbBlockReference" ' Cas d'un texte dans un attribut de bloc Dim varAttributes As Variant varAttributes = texteref.GetAttributes Htxt = varAttributes(0).height End Select largeur_mini = 7 * Htxt ' Initialisation des variables i = 0 j = 0 k = 0 a = "Oui" ReDim vertices(0 To 1000) ' Redimensionnement du tableau de points ' Boucle pour saisir plusieurs points pour la plyligne While (a = "Oui") pnt = ThisDrawing.Utility.GetPoint(, "Sélectionner un point ? ") j = i + 1 k = j + 1 vertices(i) = pnt(0): vertices(j) = pnt(1): vertices(k) = pnt(2) Reponse = ThisDrawing.Utility.GetString(False, "Autre point Oui ou Non (Taper pour valider): ") Select Case Reponse Case "o", "O" a = "Oui" Case "n", "N" a = "Non" End Select j = i + 1 k = j + 1 i = k + 1 Wend ReDim Preserve vertices(0 To k) ' Redimensionnement du tableau de points en fonction de nombre de points réels ' Dessin de la polyligne Set polyObj = ThisDrawing.ModelSpace.AddPolyline(vertices) polyObj.Closed = True 'création de la région Set region_element(0) = polyObj region = ThisDrawing.ModelSpace.AddRegion(region_element) ' Transformation de la region Variant en objet region pour après trouver le centre Set boxObj = region(0) ' Le point de base du texte est le centre de la region Centroid = boxObj.Centroid returnPnt(0) = Centroid(0): returnPnt(1) = Centroid(1): returnPnt(2) = 0 ' Saisie au prompt du code du local code = ThisDrawing.Utility.GetString(True, "Code du local (Taper pour valider): ") ' Operations pour définir une largeur de texte cohérente avec la longueur du texte largeur_texte = Len(code) * Htxt If largeur_texte > largeur_mini Then largeur = largeur_texte Else largeur = largeur_mini End If ' Création du texte avec le code du local et sur la ligne en dessous la surface arrondi 0.00 toto = polyObj.ObjectID ' recup de l'ID de la polyligne echelle = "ct8[" & rapport & "]" titi = "" & "\f " & Chr(34) & Chr(37) & "lu2" & Chr(37) & "pr2" & Chr(37) & echelle & Chr(34) & "" texte = code & vbCrLf & "%<\AcObjProp Object(%<\_ObjId " & toto & ">%).Area " & titi & ">%" & " m²" ' concatenation champs + code local Set objMtexte = ThisDrawing.ModelSpace.AddMText(returnPnt, largeur, texte) objMtexte.height = Htxt End Sub

Ca marche !!!!! Impec merci encore.

Salut, Ouh je sens que c'est sioux là. Mais de tête sans avoir tester c'est un truc qui me plait. Je teste demain. Merci encore affaire à suivre.

Bonsoir, Je reviens sur un sujet déjà évoqué mais où la réponse ne correspond pas à mon cas. En gros je crée une polyligne avec les points saisis par l'utilisateur. Ensuite je crée une région sur cette polyligne et je veux récupérer le centroid de la région. Et le pb est que une fois la région créé c'est un variant et la récup du centroid se fait sur un acadregion je sais plus quoi. Donc là il faut que je demande à l'utilisateur de choisir la région qu'il vient de faire. Le but est de sauter l'étape où l'utilisateur rechoisi sa région. Actuellement je fais cela : ' Dessin de la polyligne Set polyObj = ThisDrawing.ModelSpace.AddPolyline(vertices) polyObj.Closed = True ' cloture de la polyligne 'création de la région Set region_element(0) = polyObj region = ThisDrawing.ModelSpace.AddRegion(region_element) ' Choix de la région pour en calculer le centre ThisDrawing.Utility.GetEntity boxObj, basePnt, "Sélectionnez la région SVP" ' Le point de base du texte est le centre de la region Centroid = boxObj.Centroid returnPnt(0) = Centroid(0): returnPnt(1) = Centroid(1): returnPnt(2) = 0 Quelqu'un aurait-il une idée ? Merci à vous. PS : la seule idée qui me vient mais qui n'est pas la plus simple est de dessiner un Acad3DSolid à la place de la polyligne. Mais ça me parait compliqué comme truc.

Bonjour, Je reviens sur cet outils car il a des lacunes. En même temps je l'ai pondu sur un bout de table en peu de temps. Donc je le reprend et j'ai intégré l'unité de la surface "m²". J'ai rajouté la gestion de l'unité du dessin car si le plan est en cm la surface inséré par le champ est en cm² et je vous laisse imaginer si c'est du mm alors la valeur monstrueuse et peu parlante de la surface. Pour cela je place lors de la première utilisation du code une propriété personnalisé dans les infos du fichier (comme la où est rentré auteur...) et je récupère la valeur lors de la seconde utilisation. Et après je fais un rapport sur la surface calculée dans le champs. Tout cela est prévu en fait dans les options du champs aire. Reste à gérer la hauteur de texte lorsqu'on choisit un attribut et non un text ou mtext pour reproduire la même hauteur. C'est également un bon exercice d'école pour gérer des trucs pas super documenter. Je vous mets ca dans les prochaines semaines.

salut, Moi j'ai utiliser un calque et posé ma polyligne sur le calque courant. Mais tu dois pouvoir adapter cette méthode à la polyligne il me semble l'avoir déjà fait. Set layerObj = ThisDrawing.Layers.Add("Repérage") layerObj.color = acMagenta ThisDrawing.ActiveLayer = layerObj @+

Bonjour à tous, Alors voilà la bête. En résumé ça fait : - Création calque "réparage" couleur magenta - Demande de choisir un élément de texte du dessin pour en reprendre la hauteur du texte - Permet de dessiner la polyligne en choisissant au fur et à mesure si on veut continuer la polyligne (O ou N) et fermeture de la polyligne (La fonction sera revue à terme je pense) - Choix du point de base du texte - Saisie du texte (code ou repère de la pièce) - Insertion du texte sur 2 ligne avec le code ou repère et en dessous le champs surface de la polyligne pour mise à jour automatique si modif. Sub plan_reperage() ' Déclaration des variables Dim returnObj As AcadObject Dim returnPnt As Variant Dim basePnt As Variant Dim code As String Dim texte As String Dim largeur As Double Dim Htxt As Double Dim objMtext As AcadMText Dim a As String Dim Reponse As String Dim vertices() As Double Dim pnt As Variant Dim i, j As Integer Dim polyObj As AcadPolyline Dim toto, titi As String Dim layerObj As AcadLayer Dim texteref As AcadObject ' Creation du calque repérage de couleur magenta Set layerObj = ThisDrawing.Layers.Add("Repérage") layerObj.color = acMagenta ThisDrawing.ActiveLayer = layerObj ' Selection d'un texte du dessin pour récupérer les hauteurs de texte du dessin ThisDrawing.Utility.GetEntity texteref, basePnt, "Sélectionner un texte pour définir la hauteur : " Htxt = texteref.height largeur = 5 ' Initialisation des variables i = 0 j = 0 k = 0 a = "Oui" ReDim vertices(0 To 1000) ' Redimensionnement du tableau de points ' Boucle pour saisir plusieurs points pour la plyligne While (a = "Oui") pnt = ThisDrawing.Utility.GetPoint(, "Sélectionner un point ? ") j = i + 1 k = j + 1 vertices(i) = pnt(0): vertices(j) = pnt(1): vertices(k) = pnt(2) Reponse = ThisDrawing.Utility.GetString(False, "Autre point Oui ou Non (Taper pour valider): ") Select Case Reponse Case "o", "O" a = "Oui" ' Effectue une action. Case "n", "N" a = "Non" ' Effectue une action. End Select j = i + 1 k = j + 1 i = k + 1 Wend ReDim Preserve vertices(0 To k) ' Redimensionnement du tableau de points en fonction de nombre de points réels ' Dessin de la polyligne Set polyObj = ThisDrawing.ModelSpace.AddPolyline(vertices) polyObj.Closed = True ' cloture de la polyligne ' Choix du point de base du texte returnPnt = ThisDrawing.Utility.GetPoint(, "Sélectionner le point de base du texte.") ' Saisie au prompt du code du local code = ThisDrawing.Utility.GetString(True, "Code du local (Taper pour valider): ") ' Création du texte avec le code du local et sur la ligne en dessous la surface arrondi 0.00 toto = polyObj.ObjectID ' recup de l'ID de la polyligne titi = "" & "\f " & Chr(34) & Chr(37) & "lu2" & Chr(37) & "pr2" & Chr(34) & "" ' mise en forme de l'arrondi texte = code & vbCrLf & "%<\AcObjProp Object(%<\_ObjId " & toto & ">%).Area " & titi & ">%" ' concatenation champs + code local Set objMtexte = ThisDrawing.ModelSpace.AddMText(returnPnt, largeur, texte) objMtexte.height = Htxt End Sub

J'ai trouvé un bout de réponse : ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an object" toto = returnObj.ObjectID text = "%<\AcObjProp Object(%<\_ObjId " & toto & ">%).Area>%" insertionPoint(0) = 2: insertionPoint(1) = 2: insertionPoint(2) = 0 height = 0.5 ' Create the text object in model space Set textObj = ThisDrawing.ModelSpace.AddText(text, insertionPoint, height) En fait vous sélectionner l'objet et il vous insère un champs avec la surface qui sera mise à jour sur régén du dessin si mise à jour de la polyligne. Encore quelques améliorations et je vais être au top. Je test plusieurs choses mais je suis déjà très content d'en être arrivé là. Merci encore @ tous @ bientôt pour la suite du prog.