sujet Re: Communication Excel - AutoCAD dans AutoCAD – tous produits - Forum Français

Communication Excel - AutoCAD

jverdier927VN — Thu, 17 Mar 2022 09:39:17 GMT

Bonjour a tous,

je vous explique mon pb.

je possède un outil développé sous excel me permettant de faire du dessin sur autocad via une macro.

Cet outil me permet également une fois les données et calculs faits, de remplir l'onglet "Résultats" avec du matériel. Je souhaiterai via un bouton pouvoir écrire ces lignes dans mon fichier autocad (dans l'onglet présentation) pour éviter de devoir le saisir à la main. J’espère m’être exprimer clairement sinon n’hésitez pas 🙂

Actuellement le bouton "exporter matériel" marche et me créer un txt mais cela ne me permets pas d’intégrer dans le dwg...

ci joint le fichier en question avec la trame AutoCAD.

Re: Communication Excel - AutoCAD

Y.AUBRY — Thu, 17 Mar 2022 17:17:52 GMT

Bonjour,

Je vais regarder ce que je peux faire. Normalement il ne devrait pas y avoir de problème... ca fait bien longtemps que je n'ai plus développer en VBA pour AutoCAD (VB.NET est nettement plus complet).

Par contre j'ai deux remarques et une question :

- Remarque 1 : Lors de la livraison de DWG, il est préférable de les enregistrer dans une version 2000 pour qu'il puisse être ouvert sur l'ensemble des postes.

- Remarque 2 : Les macros VBA du fichier "ancrage V2.0 pour forum.xlsm" étaient actuellement protégés par mot de passe donc le code n'était pas modifiable en l'état normalement (j'ai pu le faire sauter, par contre je ne me considère pas comme responsable en cas de litige)

Dans le code on trouve :

' ' ' Propriété de Valentin LAMOUREUX ' ---- NGE TSO CATENAIRES ---- ' ---- NGE TSO CATENAIRES ---- ' ---- NGE TSO CATENAIRES ---- ' '

Question :

- Le bloc "nom_anc" que tu cherches a ajouter dans ton tableau est-il déjà présent dans le dwg lors du lancement de la commande? Si non, merci de me préciser son emplacement sur ton PC / serveur.

Je regarderai ça a tête reposée ce week-end, merci de répondre à ma question d'ici là stp.

Yoan

Re: Communication Excel - AutoCAD

jverdier927VN — Thu, 17 Mar 2022 17:55:59 GMT

Bjr Y.AUBRY,

merci deja d'avoir pris le temps de lire mon post.

Concernant tes remarques, voici mes réponses:

Rrmq 1 concernant les versions d'autoCAD: dans notre métier on nous impose des versions versions minimum 2018 voir 2010 pour autoCAD.

Rmq 2: Pour le mot de passe aucun soucis j'ai juste oublié de l'enlever...désolé

Je te rejoins le fichier sans mdp 😉

Pour le bloc "nom_anc" est présent dans le dwg (c'est une feuille type). Si il faut le modifier je le ferai rien n'est bloqué tout est modifiable si ca permets que ca fonctionne.

Merci deja par avance et bonne soirée.

Julien

Re: Communication Excel - AutoCAD

Luna3 — Fri, 18 Mar 2022 08:46:25 GMT

Coucou,
Sujet en doublon ici : https://cadxp.com/topic/55560-communication-excel-autocad/#comment-315643

Bisous,
Luna

Re: Communication Excel - AutoCAD

Y.AUBRY — Fri, 18 Mar 2022 14:08:50 GMT

Bonjour,

Ci-joint le code pour la mise à jour du module "Export_Nomenclature"

Tu as un exemple pour insérer un bloc avec mise à jour d'attributs

Je te laisse finaliser pour la mise en forme (positions des blocs, chargement des autres informations...)

Bonne continuation

Yoan

Re: Communication Excel - AutoCAD

Y.AUBRY — Fri, 18 Mar 2022 14:12:00 GMT

Si jamais tu veux modifier le calque dans lequel les blocs sont insérés il faut modifier la ligne suivante

objBRef.Layer = "0"

et changer le "0" par le nom de ton calque

Re: Communication Excel - AutoCAD

jverdier927VN — Fri, 18 Mar 2022 14:18:50 GMT

Bonjour y.Aubry

super merci bcp d'avoir pris le temps de regarder cela, je vais tester ca ce weekend.

Merci en core.

Bon weekend et je reviens vers toi pour te dire.

Julien

Re: Communication Excel - AutoCAD

Y.AUBRY — Fri, 18 Mar 2022 14:38:04 GMT

Re-bonjour,

Je viens de m'apercevoir que dans ton fichier dwg il y a déjà un bloc attributaire nommé TSO-anc comportant de nombreux attributs permettant de remplir les informations du tableau

Il aurait été plus simple de le spécifier au départ et de faire la mise à jour de ce bloc plutôt que d'insérer des nouveaux blocs.

Pour information, pour une meilleure organisation des attributs de ce bloc, je te conseille de rentrer dans l'éditeur de bloc (commande "BEDIT") puis d'utiliser la commande "ORDREATTBLOC" pour réorganiser l'ordre des attributs dans ton bloc via les boutons Monter et Descendre sachant qu'une fois que tu à appuyer sur le bouton Monter par exemple tu peux appuyer sur la touche M pour continuer à le faire monter dans la liste (et D pour Descendre)

Une fois cela fait et après avoir fermer l'éditeur de bloc, il faudra synchroniser tes attributs via la commande ATTSYNC

Une fois que tu as bien organiser tes attributs, tu pourrais utilise les commandes ATTOUT pour faire un export des attributs, faire la MAJ via un copier coller puis un ATTIN pour les réinjecter

Bon courage,

Yoan

Re: Communication Excel - AutoCAD

jverdier927VN — Fri, 18 Mar 2022 14:41:36 GMT

je viens d'essayer mais je me retrouve avec ce msg....

Re: Communication Excel - AutoCAD

Y.AUBRY — Fri, 18 Mar 2022 14:57:18 GMT

Une fois que tu auras repris l'ordre des attributs du bloc, ré-envois moi le fichier dwg mis à jour.

Je te ferai la MAJ du code VBA pour pouvoir injecter directement les valeurs dans les attributs du bloc TSO-anc.

Pour l'instant, je me mets en mode we...

Bon we et à lundi

Re: Communication Excel - AutoCAD

Y.AUBRY — Fri, 18 Mar 2022 14:58:53 GMT

OK, j'ai oublié de mettre les "Byval"...

Ci-joint la MAJ de la sub

Public Sub Insert_Bloc_Nom_Anc(AcadPlan As AcadDocument, X As Double, Y As Double, ByVal DESIGNATION As String, ByVal PLAN As String, ByVal REPERE As String, ByVal QTE As String) Dim objBRef As AcadBlockReference Dim PtIns(0 To 2) As Double PtIns(0) = X PtIns(1) = Y PtIns(2) = 0 Dim Att As Variant Dim AttCount As Integer Set objBRef = AcadPlan.PaperSpace.InsertBlock(PtIns, "Nom_Anc", 1, 1, 1, 0) objBRef.Layer = "0" objBRef.Update For Each Att In objBRef.GetAttributes Select Case Att.TagString Case "DESIGNATION" Att.TextString = DESIGNATION Case "PLAN" Att.TextString = PLAN Case "REPERE" Att.TextString = REPERE Case "QTE" Att.TextString = QTE End Select Next objBRef.Update End Sub

Re: Communication Excel - AutoCAD

jverdier927VN — Fri, 18 Mar 2022 15:16:17 GMT

En effet, logiquement il n'y a pas autant d'attribut dans ce bloc c'est un vieux bloc. Je viens de le remettre a jour sans tous ces attributs.

Re: Communication Excel - AutoCAD

jverdier927VN — Fri, 18 Mar 2022 16:35:35 GMT

Super ca fonctionne a merveille. Me reste plus qu'à bidouiller pour que cela m'ajoute les autres lignes et au bon endroit.
Un grand merci pour ton aide!!!

Re: Communication Excel - AutoCAD

Y.AUBRY — Sat, 19 Mar 2022 08:08:11 GMT

Bonjour,

Pas de soucis, j'espère que tu arriveras à programmer le reste.

Pour le reste, du coup, je te conseille de faire quelque chose comme cela (je n'ai pas fait de test)

Public Sub ExportNomenclatureTeemo() Call Concat_Mat Call Ecriture_Nomenclature1 Call Ecriture_Nomenclature2 'Nécessite la référence Autocad xxx Type Library (Menu Outils > Références) Dim AcadApp As AcadApplication, AcadPlan As AcadDocument 'Création de l'objet AutoCAD dans Excel : Set AcadApp = AcadApplication 'Rend AutoCAD visible AcadApp.Visible = True 'ou sinon, utilise le document ouvert : Set AcadPlan = AcadApp.ActiveDocument Dim Cible As Integer, i As Integer, j As Integer Dim Repertoireactuel As String Dim Name As String Dim nbcar As Integer Dim val As Integer ' --- Demande du chemin pour export --- Name = AcadPlan.Name Name = Left(Name, Len(Name) - 4) Dim Wb As Workbook Set Wb = ActiveWorkbook Dim WsR As Worksheet Set WsR = Wb.Worksheets("Resultats") Dim DL As Integer 'dernière ligne du tableau DL = WsR.Cells(Rows.Count, 1).End(xlUp).Row If MsgBox("Voulez vous exporter la Nomenclature sur la feuille active:" & vbLf & Name & " ?", 4 + 64 + 256, "Chemin d'acces") = 6 Then Dim ent As AcadEntity Dim Block, BlkTSO As AcadBlockReference Dim bFound As Boolean bFound = False For Each ent In ThisDrawing.PaperSpace If TypeOf ent Is AcadBlockReference Then Set Block = ent If UCase(Block.EffectiveName) = "TSO-anc" Then Set BlkTSO = Block bFound = True Exit For End If End If Next 'Si le bloc "TSO-anc" a été trouvé If bFound = True Then 'Récupération de la position X, Y du bloc TSO pour pouvoir ajouter les 'blocs Nom_Anc avec une position relative par rapport à ce bloc Dim X_TSO, Y_TSO As Double X_TSO = Block.InsertionPoint.X Y_TSO = Block.InsertionPoint.Y 'Mise à jour des attributs du bloc TSO-anc Dim Att As Variant Dim AttCount As Integer For Each Att In BlkTSO.GetAttributes Select Case Att.TagString 'A modifier Case "AAAA" Att.TextString = WsR.Range("A" & 1).Value Case "BBBB" Att.TextString = WsR.Range("A" & 1).Value Case "CCCC" Att.TextString = WsR.Range("A" & 1).Value Case "DDDD" Att.TextString = WsR.Range("A" & 1).Value End Select Next BlkTSO.Update Dim NumCol, NbL_Anc1, NbL_Anc2 As Integer NbL_Anc1 = 0 'Nombre de ligne du coté Ancrage 1 pour la gestion du Y de l'insertion des blocs NbL_Anc2 = 0 For NumCol = 13 To DL If WsR.Range("B" & NumCol).Value <> "" Then If WsR.Range("B" & NumCol).Value = "------------------------------------------------" Then NbL_Anc1 = NbL_Anc1 + 1 Else Dim DESIGNATION, PLAN, REPERE, QTE As String DESIGNATION = WsR.Range("A" & NumCol).Value PLAN = WsR.Range("B" & NumCol).Value REPERE = WsR.Range("C" & NumCol).Value QTE = WsR.Range("D" & NumCol).Value 'Insertion d'un bloc "Nom_Anc" dans l'espace papier en coursavec mise à jour des attributs Insert_Bloc_Nom_Anc AcadPlan, X_TSO + 10, Y_TSO + 110 - 3.692 * NbL_Anc1, DESIGNATION, PLAN, REPERE, QTE NbL_Anc1 = NbL_Anc1 + 1 End If End If Next For NumCol = 13 To DL If WsR.Range("F" & NumCol).Value <> "" Then If WsR.Range("F" & NumCol).Value = "------------------------------------------------" Then NbL_Anc2 = NbL_Anc2 + 1 Else Dim DESIGNATION, PLAN, REPERE, QTE As String DESIGNATION = WsR.Range("F" & NumCol).Value PLAN = WsR.Range("G" & NumCol).Value REPERE = WsR.Range("H" & NumCol).Value QTE = WsR.Range("I" & NumCol).Value 'Insertion d'un bloc "Nom_Anc" dans l'espace papier en coursavec mise à jour des attributs Insert_Bloc_Nom_Anc AcadPlan, X_TSO + 105, Y_TSO + 110 - 3.692 * NbL_Anc2, DESIGNATION, PLAN, REPERE, QTE NbL_Anc2 = NbL_Anc2 + 1 End If End If Next End If End If End Sub Public Sub Insert_Bloc_Nom_Anc(AcadPlan As AcadDocument, X As Double, Y As Double, ByVal DESIGNATION As String, ByVal PLAN As String, ByVal REPERE As String, ByVal QTE As String) Dim objBRef As AcadBlockReference Dim PtIns(0 To 2) As Double PtIns(0) = X PtIns(1) = Y PtIns(2) = 0 Dim Att As Variant Dim AttCount As Integer Set objBRef = AcadPlan.PaperSpace.InsertBlock(PtIns, "Nom_Anc", 1, 1, 1, 0) objBRef.Layer = "0" objBRef.Update For Each Att In objBRef.GetAttributes Select Case Att.TagString Case "DESIGNATION" Att.TextString = DESIGNATION Case "PLAN" Att.TextString = PLAN Case "REPERE" Att.TextString = REPERE Case "QTE" Att.TextString = QTE End Select Next objBRef.Update End Sub

Re: Communication Excel - AutoCAD

jverdier927VN — Sun, 20 Mar 2022 07:49:35 GMT

Bjr Y.AUBRY,

je vais regarder cela et essayer de comprendre le dernier code que tu as ecris.

je te tiens au courant.

merci de ton aide en tout cas!

Julien

Re: Communication Excel - AutoCAD

Y.AUBRY — Mon, 21 Mar 2022 09:34:00 GMT

Bonjour,

Je me base du coup sur ce modèle pour la suite du code

Ci-joint le code finaliser:

Public Sub ExportNomenclatureTeemo() Call Concat_Mat Call Ecriture_Nomenclature1 Call Ecriture_Nomenclature2 'Nécessite la référence Autocad xxx Type Library (Menu Outils > Références) Dim AcadApp As AcadApplication, AcadPlan As AcadDocument 'Création de l'objet AutoCAD dans Excel : Set AcadApp = AcadApplication 'Rend AutoCAD visible AcadApp.Visible = True 'ou sinon, utilise le document ouvert : Set AcadPlan = AcadApp.ActiveDocument Dim Cible As Integer, i As Integer, j As Integer Dim Repertoireactuel As String Dim Name As String Dim nbcar As Integer Dim val As Integer Dim Wb As Workbook Set Wb = ActiveWorkbook Dim WsR As Worksheet Set WsR = Wb.Worksheets("Resultats") Dim DL As Integer 'dernière ligne on vide du tableau excel DL = WsR.Cells(Rows.Count, 1).End(xlUp).Row ' --- Demande du chemin pour export --- Name = AcadPlan.Name Name = Left(Name, Len(Name) - 4) If MsgBox("Voulez vous exporter la Nomenclature sur la feuille active:" & vbLf & Name & " ?", 4 + 64 + 256, "Chemin d'acces") = 6 Then Dim ent As AcadEntity Dim block, BlkTSO As AcadBlockReference Dim bFound As Boolean bFound = False For Each ent In AcadPlan.PaperSpace If TypeOf ent Is AcadBlockReference Then Set block = ent If block.EffectiveName = "TSO-anc" Then bFound = True Set BlkTSO = ent Exit For End If End If Next 'Si le bloc "TSO-anc" a été trouvé If bFound = True Then 'Récupération de la position X, Y du bloc TSO pour pouvoir ajouter les 'blocs Nom_Anc avec une position relative par rapport à ce bloc Dim X_TSO, Y_TSO As Double X_TSO = BlkTSO.InsertionPoint(0) 'récupération de la position en X du bloc TSO-ANC Y_TSO = BlkTSO.InsertionPoint(1) 'récupération de la position en Y du bloc TSO-ANC 'Mise à jour des attributs du bloc TSO-anc Dim Att As Variant Dim AttCount As Integer For Each Att In BlkTSO.GetAttributes Select Case Att.TagString Case "massif_1" Att.TextString = WsR.Range("F5").Value 'A compléter s'il y a d'autres informations a mettre à jour 'dans les attributs du bloc TSO-ANC ' Case "BBBB" ' Att.TextString = WsR.Range("A" & 1).Value ' Case "CCCC" ' Att.TextString = WsR.Range("A" & 1).Value ' Case "DDDD" ' Att.TextString = WsR.Range("A" & 1).Value End Select Next BlkTSO.Update Dim NumCol, NbL_Anc1, NbL_Anc2 As Integer Dim DESIGNATION, PLAN, REPERE, QTE As String NbL_Anc1 = 0 'Nombre de ligne du coté Ancrage 1 pour la gestion du Y de l'insertion des blocs NbL_Anc2 = 0 'Nombre de ligne du coté Ancrage 2 pour la gestion du Y de l'insertion des blocs 'On parcours toutes les lignes entre la 13 et la dernière ligne du document Excel For NumCol = 13 To DL If WsR.Range("A" & NumCol).Value <> "" Then 'Si la cellule colonne A de la ligne en cours n'est pas vide If WsR.Range("A" & NumCol).Value Like "---*" Then 'Si la cellule colonne A de la ligne commence par "---" 'NbL_Anc1 = NbL_Anc1 + 1 'on incrément NbL_Anc1 pour décaler d'un cran en Y Else 'Si la cellule colonne B de la ligne en cours n'est pas vide et ne commence pas par "---" 'On récupère les valeurs des colonnes A, B, C, D de la ligne en cours DESIGNATION = WsR.Range("A" & NumCol).Value PLAN = WsR.Range("B" & NumCol).Value REPERE = WsR.Range("C" & NumCol).Value QTE = WsR.Range("D" & NumCol).Value 'Insertion d'un bloc "Nom_Anc" dans l'espace papier en coursavec mise à jour des attributs Insert_Bloc_Nom_Anc AcadPlan, X_TSO + 10, Y_TSO + 110.532 - 3.692 * NbL_Anc1, DESIGNATION, PLAN, REPERE, QTE NbL_Anc1 = NbL_Anc1 + 1 End If End If Next 'Même principe pour l'ancrage N°2 For NumCol = 13 To DL If WsR.Range("F" & NumCol).Value <> "" Then If WsR.Range("F" & NumCol).Value Like "---*" Then 'Si la cellule colonne F de la ligne commence par "---" 'NbL_Anc2 = NbL_Anc2 + 1 Else DESIGNATION = WsR.Range("F" & NumCol).Value PLAN = WsR.Range("G" & NumCol).Value REPERE = WsR.Range("H" & NumCol).Value QTE = WsR.Range("I" & NumCol).Value 'Insertion d'un bloc "Nom_Anc" dans l'espace papier en coursavec mise à jour des attributs Insert_Bloc_Nom_Anc AcadPlan, X_TSO + 105.201, Y_TSO + 110.532 - 3.692 * NbL_Anc2, DESIGNATION, PLAN, REPERE, QTE NbL_Anc2 = NbL_Anc2 + 1 End If End If Next End If End If End Sub Public Sub Insert_Bloc_Nom_Anc(AcadPlan As AcadDocument, X As Double, Y As Double, ByVal DESIGNATION As String, ByVal PLAN As String, ByVal REPERE As String, ByVal QTE As String) Dim objBRef As AcadBlockReference Dim PtIns(0 To 2) As Double PtIns(0) = X PtIns(1) = Y PtIns(2) = 0 Dim Att As Variant Dim AttCount As Integer Set objBRef = AcadPlan.PaperSpace.InsertBlock(PtIns, "Nom_Anc", 1, 1, 1, 0) objBRef.Layer = "0" objBRef.Update For Each Att In objBRef.GetAttributes Select Case Att.TagString Case "DESIGNATION" Att.TextString = DESIGNATION Case "PLAN" Att.TextString = PLAN Case "REPERE" Att.TextString = REPERE Case "QTE" Att.TextString = QTE End Select Next objBRef.Update End Sub

Re: Communication Excel - AutoCAD

jverdier927VN — Tue, 22 Mar 2022 07:27:20 GMT

Bonjour Y AUBRY,

ca marche nickel je te remercie bcp pour cette aide!!

J'ai quelques retouche à faire (chercher les bonnes cellules 😉 )mais ca devrait le faire pour que cela me fasse gagner considérablement du temps!

Merci encore.

julien.

Re: Communication Excel - AutoCAD

Y.AUBRY — Tue, 22 Mar 2022 07:49:33 GMT

Bonjour @jverdier927VN ,

Content d'avoir pu t'aider.

Dans ces cas-là, je te laisse cliquer sur le bouton APPROUVER LA SOLUTION en bas de la réponse qui apporte une solution (le message 16 étant le plus complet) pour que le sujet soit marqué comme traité et que la communauté puisse avoir accès à la solution rapidement.

PI : J'ai précisé sur Cadxp que ce sujet est finalisé.

Bonne continuation,

Yoan