TiChan

Malheureusement rien n'a changé... tous mes nouveaux tracés sont à une autre élévation que 0.

Peut on modifier l'élévation courante dans le dessin?

Bonjour, Je viens vers vous pour un souci sur un fichier que je ne m'explique pas. Voici mon problème : L'ensemble de mon dessin est à l'altitude ou élévation = 0 Lorsque je trace une polyligne ou tout autre élément sur mon fichier, celui ci se retrouve à une altitude de -999999. Je me retrouve donc systématiquement à remettre les éléments à l'altitude 0 pour que les accrochages et autres commandes de dessin puisse fonctionner. Avez vous la solution à mon pb? Merci!

Merci. Je ne crois pas que mon patron soit très motivé à investir beaucoup d'argent en ce moment... Quoi qu'il en soit il est vrai que je travail avec des fichiers parfois assez lourd, mais surtout avec de nombreuses xref imbriquées et sous-imbriquées. Je vais voir pour une methodo ou on va bien nettoyer les fichiers à la base , et peu être insérer les xref qui ne vont pas bouger en tant que bloc directement. On verra si ça joue mieux comme cela.

Merci pour vos réponses. Je suis sous autocad 2011. Notre fournisseur de matériel va nous prêter une carte graphique pro pour voir si le problème vient de là, ou si cela peu améliorer de façon significative la performance de nos pc.

Merci. C'est un problème d'ordre général qui m'arrive très fréquemment. Ce que je fait et en général cela va vraiment mieux après, c'est que je purge toute les xrefs y compris celles qui sont imbriquées et je supprime celles qui sont introuvables. En général cela va mieux. Par contre lorsque que cela m'arrive alors que je n'ai que deux ou trois fichiers basiques d'ouvert, ce n'est pas acceptable dans une utilisation professionnelle.

Bonjour, Je viens vers vous pour trouver un moyen d'améliorer de façon significatives les performances de Autocad notamment. Voici la configuration de mon ordinateur: Intel® Core2 Quad CPU Q8400 @2.66GHz 2.67GHz RAM : 4.00 Go Win 7 32bits Je travaille avec des fichiers qui ont des Xref, et j'ai très régulièrement des erreurs fatales. Surtout lorsque j'ouvre un deuxième ou troisième fichier. Je souhaite mettre une carte graphique de type ATI FIREPRO V5800 ou V7800 (la carte graphique de l'ordi est intégrée). Pensez vous que ce soit utile et que cela va résoudre les problème récurrents que je rencontre? Merci pour votre aide, et avec mes meilleures salutations.

Bonjour à tous, Existe t il un moyen simple de conserver visuellement les échelles de type de ligne lorsqu'on importe dans un plan une xref dont les unité ne sont pas les mêmes? Par exemple, j'ai un plan en cm et j'importe une xref qui est en m. Les échelles des types de lignes ne correspondent pas d'elles mêmes. J'ai pour habitude d'effectuer quelques bidouilles pour arriver à mes fins mais je pense qu'il doit être possible de faire autrement. Avez vous une astuce? Merci à tous.

Merci! Je venais juste de le faire après une petite recherche sur le net. Salutations!

Bonjour, J'ai entrepris de personaliser mon espace de travail dans autocad archi 2011. ceci étant fait, j'ai le souci que le panneau d'édition de hachure ne se charge pas lorsque je souhaite faire un hachurage, et en plus cela ralenti pas mal l'ordi en me proposant le hachurage selon la zone ou le curseur est placé. je suppose que ça doit encore être une variable a passer de 0 à 1? merci pour votre aide! Tichan

C'est super! Merci beaucoup! je test de suite!

Bonjour à tous! Voici mon problème : J'ai un fichier avec un plan de géomètre en xref. J'utilise les .stb afin d’afficher les éléments comme je le souhaite dans les présentations. Mon but est d'imprimer la xref en niveau de gris. jusque là, pas de soucis. par défaut les calques de la Xref ont le style "normal". dans l'espace objet je rentre dans le gestionnaire de calque, et j'attribut aux calques de la Xref un style de tracé en niveau de gris. Lorsque je fais une impression de mon plan en pdf, tout est ok. Je fais une sauvegarde de l'état des calques. Tout joue nickel. Seulement, lorsque je ferme le fichier et que je le rouvre ultérieurement, le style des calques de la Xref est revenu à "normal", et je dois à chaque fois recommencer la manip ci-dessus. Quelqu'un à une idée sur la source du problème et comment le résoudre? Ps : j'ai déja eu le même souci avec la couleur ou l'affichage d'un calque de xref que je modifie depuis le fichier de travail. Merci pour votre aide. Tichan

Bonjour, Merci beaucoup! je n'ai bizarrement pas le traceur dwg to pdf au bureau, mais je vais essayer de faire le test. salutations!

Bonjour, J'ai un souci au niveau des impressions des transparences lorsque j'imprime en .pdf avec le traceur Adobe : En effet le .pdf généré n'est pas vectoriel. J’obtiens une image fortement pixelisée et qui met du temps à se générer. Avez vous une idée de l'origine du problème? Peut être n'est-ce tout simplement pas possible? En vous remerciant pour votre aide. Tichan

Bonjour, J'ai un souci au niveau des impressions des transparences lorsque j'imprime en .pdf avec le traceur Adobe : En effet le .pdf généré n'est pas vectoriel. J’obtiens une image fortement pixelisée et qui met du temps à se générer. Avez vous une idée de l'origine du problème? Peut être n'est-ce tout simplement pas possible? En vous remerciant pour votre aide. Tichan

Salut! Et voila c'est magnifique! Un grand merci pour ton aide et pour le temps consacré. Voici l'ensemble du code pour ceux que cela pourrai intéresser : Dim DrawingFile As String Sub EnvoyerVersAutoCAD() Dim AcadApp As AutoCAD.AcadApplication Dim BlocRef As AcadBlockReference Dim Row, i, Column As Integer ' Connexion avec AutoCAD (on le lance si il n'est pas en cours d'exécution) On Error Resume Next Set AcadApp = GetObject(, "AutoCAD.Application") On Error GoTo 0 If AcadApp Is Nothing Then Set AcadApp = New AutoCAD.AcadApplication End If AcadApp.Visible = True ' Si le chemin du fichier n'est pas spécifié, on suppose qu'il est dans le même répertoire que le classeur Dim Filename As String If InStr(Cells(1, 1).Text, "\") <> 0 Then Filename = Cells(1, 1).Text Else Filename = ThisWorkbook.Path & "\" & Cells(1, 1).Text End If ' On ouvre le fichier DWG dans AutoCAD ou on l'active si il est déjà ouvert Dim Opened As Boolean Opened = False Dim Dwg As AcadDocument For Each Dwg In AcadApp.Documents If StrComp(Dwg.FullName, Filename, vbTextCompare) = 0 Then Dwg.Activate Opened = True End If Next If Not Opened Then AcadApp.Documents.Open (Filename) End If Row = 4 ' On commence à la ligne N°4 Dim Handle As String While Not IsEmpty(Cells(Row, 2)) ' On s'arrête quand on tombe sur une cellule handle vide ' On retrouve l'insertion de bloc à l'aide du handle mémorisé dans la feuille de calcul et de la ' méthode HandleToObject de l'objet document AutoCAD Handle = Cells(Row, 2) Set BlocRef = AcadApp.ActiveDocument.HandleToObject(Handle) ' Si le bloc a des attributs... If BlocRef.HasAttributes Then ' ... on les récupère Attributes = BlocRef.GetAttributes ' On parcourt le tableau For i = LBound(Attributes) To UBound(Attributes) ' Pour chaque attribut, on cherche une colonne dont l'entête correspond à l'étiquette ' de l'attribut Column = 3 While Not IsEmpty(Cells(3, Column)) If Cells(3, Column).Text = Attributes(i).TagString Then Attributes(i).TextString = Cells(Row, Column).Text End If Column = Column + 1 ' On passe à la colonne suivante Wend Next ' PROPDYN Attributes = BlocRef.GetDynamicBlockProperties On Error Resume Next ' On parcourt le tableau For i = LBound(Attributes) To UBound(Attributes) ' Pour chaque attribut, on cherche une colonne dont l'entête correspond à l'étiquette ' de l'attribut Column = 3 While Not IsEmpty(Cells(3, Column)) If Cells(3, Column).Text = Attributes(i).PropertyName Then Attributes(i).Value = Cells(Row, Column).Value End If Column = Column + 1 ' On passe à la colonne suivante Wend Next BlocRef.Update End If Row = Row + 1 ' On passe à la ligne suivante Wend MsgBox "Les données ont été transférées vers AutoCAD avec succès." End Sub Public Sub ExtraireAttributs() Dim AcadApp As AutoCAD.AcadApplication Dim SelSet As AutoCAD.AcadSelectionSet Dim FilterType(0) As Integer Dim FilterData(0) As Variant Dim FiltersType, FiltersData As Variant Dim i, Row, j, Column As Integer Dim Entity As AcadEntity Dim BlocRef As AcadBlockReference Dim Attributes As Variant Dim ColumnExist As Boolean ' Efface toutes les données contenues dans la feuille Range("1:65536").ClearContents ' On demande le nom du fichier à ouvrir Dim Filename As Variant Filename = Application.GetOpenFilename("Dessins AutoCAD (*.dwg), *.dwg") If Filename = False Then Exit Sub End If Cells(1, 1).Value = Filename ' Connexion avec AutoCAD (on le lance si il n'est pas en cours d'exécution) On Error Resume Next Set AcadApp = GetObject(, "AutoCAD.Application") On Error GoTo 0 If AcadApp Is Nothing Then Set AcadApp = New AutoCAD.AcadApplication End If ' On ouvre le fichier DWG dans AutoCAD ou on l'active si il est déjà ouvert Dim Opened As Boolean Opened = False Dim Dwg As AcadDocument For Each Dwg In AcadApp.Documents If StrComp(Dwg.FullName, Cells(1, 1).Text, vbTextCompare) = 0 Then Dwg.Activate Opened = True End If Next If Not Opened Then AcadApp.Documents.Open (Cells(1, 1).Text) End If ' On remets Excel au premier plan (le lancement d'AutoCAD désactive la fenêtre Excel) Application.Visible = True ' Remplissage de l'entête du tableau Cells(3, 1).Value = "Nom du bloc" Cells(3, 2).Value = "Handle" Row = 4 ' 1ère ligne du tableau ' On crée un jeu de sélection ou on le récupère si il existe déjà On Error Resume Next Set SelSet = AcadApp.ActiveDocument.SelectionSets.Add("SELSET") If Err <> 0 Then Set SelSet = AcadApp.ActiveDocument.SelectionSets.Item("SELSET") SelSet.Clear End If ' On prépare un filtre de sélection sur les insertions de bloc FilterType(0) = 0 FilterData(0) = "INSERT" FiltersType = FilterType FiltersData = FilterData ' Sélection des entités SelSet.Select acSelectionSetAll, , , FiltersType, FiltersData ' On balaye le jeu de sélection For i = 0 To SelSet.Count - 1 Set Entity = SelSet.Item(i) ' Si l'objet est une insertion de bloc If Entity.ObjectName = "AcDbBlockReference" Then ' On précise le type de l'objet pour pouvoir accéder à ses propriétés et ' ses méthodes spécifiques Set BlocRef = Entity ' Si il a des attributs If BlocRef.HasAttributes Then Cells(Row, 1).Value = BlocRef.Name Cells(Row, 2).Value = "'" & BlocRef.Handle ' On les récupére Attributes = BlocRef.GetAttributes ' On parcourt le tableau For j = LBound(Attributes) To UBound(Attributes) ' On recherche si une colonne existe déjà pour cette étiquette d'attribut Column = 3 ColumnExist = False While Not IsEmpty(Cells(3, Column)) If Cells(3, Column).Text = Attributes(j).TagString Then ' Une colonne existe, on la remplit avec la valeur de l'atribut Cells(Row, Column).Value = Attributes(j).TextString ColumnExist = True End If Column = Column + 1 ' On passe à la colonne suivante Wend If Not ColumnExist Then ' Aucune colonne n'existe, on en crée une et on la remplit Cells(3, Column).Value = Attributes(j).TagString Cells(Row, Column).Value = Attributes(j).TextString End If Next ' Attribut suivant ' PROP DYN Attributes = BlocRef.GetDynamicBlockProperties ' On parcourt le tableau For j = LBound(Attributes) To UBound(Attributes) ' On recherche si une colonne existe déjà pour cette étiquette d'attribut Column = 3 ColumnExist = False While Not IsEmpty(Cells(3, Column)) If Cells(3, Column).Text = Attributes(j).PropertyName Then ' Une colonne existe, on la remplit avec la valeur de l'atribut Cells(Row, Column).Value = Attributes(j).Value ColumnExist = True End If Column = Column + 1 ' On passe à la colonne suivante Wend If Not ColumnExist Then ' Aucune colonne n'existe, on en crée une et on la remplit Cells(3, Column).Value = Attributes(j).PropertyName Cells(Row, Column).Value = Attributes(j).Value End If Next ' Propriété dyn suivante Row = Row + 1 ' Ligne suivante End If End If Next MsgBox "Les attributs du dessin " & Cells(1, 1).Text & " ont été extraits avec succès." End Sub Merci à Maxence et merci Rom1_am. A bientot sur les forum.

Bonsoir, Voici un lien vers une archive qui contient le fichier autocad (un bloc "Arbre" dynamique qui me sert pour des relevés de végétation et des plans) et le fichier xls avec la macro que je cherche à modifier. J'y ai mis également les éléments de base à partir desquels je suis parti (Merci à Maxence). En prévision de l'abandon du vba, il y aura t-il d'autre possibilité qui permettront ce type de communication entre logiciels différents? lisp ou autre? https://www.yousendit.com/download/UFhzZUNrNXYrV3hjR0E9PQ Salutations!

Bonsoir, Je me permet de revenir pour essayer d'aller au bout de cette démarche. Après de multiples essais et bidouilles, je n'ai toujours pas réussi à enclencher la mise à jour des propriétés récupérées dans le tableau excel vers autocad. Ce qui est interressant dans cette macro, c'est le fait de pouvoir mettre à jour les propriétés graphiques d'un ensemble de bloc (par exemple le diamètre de la couronne d'un arbre, de son tronc, et sa symbologie (feuillu ou conifère)) d'un seul coup depuis excel. Dans le cas où je n'y arrive pas, un grand merci à toi Rom1_am pour ton aide précieuse depuis le début.

Bonjour, Ca marche! merci mille fois. Ainsi j'arrive à récupérer à la fois les attributs des blocs, puis les propriétés dynamiques de ceux-ci. J'ai cependant un dernier souci à régler : Selon le même principe, je suis en train de tenter de modifier la partie du code qui me permettra de mettre à jour ces données dans autocad. Mais la macro se bloque et j'ai un message d'erreur. Erreur d’exécution 'xxxxxxxx' Entrée incorrecte Le débogueur me surligne la ligne : Attributes(i).Value = Cells(Row, Column).Value Voici l'ensemble du code que j'essaye de modifier : Dim DrawingFile As String Sub EnvoyerVersAutoCAD() Dim AcadApp As AutoCAD.AcadApplication Dim BlocRef As AcadBlockReference Dim Row, i, Column As Integer ' Connexion avec AutoCAD (on le lance si il n'est pas en cours d'exécution) On Error Resume Next Set AcadApp = GetObject(, "AutoCAD.Application") On Error GoTo 0 If AcadApp Is Nothing Then Set AcadApp = New AutoCAD.AcadApplication End If AcadApp.Visible = True ' Si le chemin du fichier n'est pas spécifié, on suppose qu'il est dans le même répertoire que le classeur Dim Filename As String If InStr(Cells(1, 1).Text, "\") <> 0 Then Filename = Cells(1, 1).Text Else Filename = ThisWorkbook.Path & "\" & Cells(1, 1).Text End If ' On ouvre le fichier DWG dans AutoCAD ou on l'active si il est déjà ouvert Dim Opened As Boolean Opened = False Dim Dwg As AcadDocument For Each Dwg In AcadApp.Documents If StrComp(Dwg.FullName, Filename, vbTextCompare) = 0 Then Dwg.Activate Opened = True End If Next If Not Opened Then AcadApp.Documents.Open (Filename) End If Row = 4 ' On commence à la ligne N°4 Dim Handle As String While Not IsEmpty(Cells(Row, 2)) ' On s'arrête quand on tombe sur une cellule handle vide ' On retrouve l'insertion de bloc à l'aide du handle mémorisé dans la feuille de calcul et de la ' méthode HandleToObject de l'objet document AutoCAD Handle = Cells(Row, 2) Set BlocRef = AcadApp.ActiveDocument.HandleToObject(Handle) ' Si le bloc a des attributs... If BlocRef.HasAttributes Then ' ... on les récupère Attributes = BlocRef.GetAttributes ' On parcourt le tableau For i = LBound(Attributes) To UBound(Attributes) ' Pour chaque attribut, on cherche une colonne dont l'entête correspond à l'étiquette ' de l'attribut Column = 3 While Not IsEmpty(Cells(3, Column)) If Cells(3, Column).Text = Attributes(i).TagString Then Attributes(i).TextString = Cells(Row, Column).Text End If Column = Column + 1 ' On passe à la colonne suivante Wend Next ' PROPDYN Attributes = BlocRef.GetDynamicBlockProperties ' On parcourt le tableau For i = LBound(Attributes) To UBound(Attributes) ' Pour chaque attribut, on cherche une colonne dont l'entête correspond à l'étiquette ' de l'attribut Column = 3 While Not IsEmpty(Cells(3, Column)) If Cells(3, Column).Text = Attributes(i).PropertyName Then Attributes(i).Value = Cells(Row, Column).Value End If Column = Column + 1 ' On passe à la colonne suivante Wend Next BlocRef.Update End If Row = Row + 1 ' On passe à la ligne suivante Wend MsgBox "Les données ont été transférées vers AutoCAD avec succès." End Sub Je ne comprend pas pourquoi ça ne marche pas. Merci encore pour ton aide.

Bonjour, je viens d'essayer, et je n'y arrive toujours pas. En fait si j'arrive à modifier cette partie du code de Maxence, cela me permettrai de comprendre comment ça marche, et de pouvoir ensuite éditer l'ensemble. Lorsque je lance la macro, celle-ci ne se bloque pas, mais n'affiche pas le résultat escompté. Seuls les noms des blocs et Handle sont récupérés. Pour faire simple je joint ci-dessous une image d'explication de ce que je cherche à faire : https://www.yousendit.com/dl?phi_action=app/orchestrateDownload&rurl=https%253A%252F%252Fwww.yousendit.com%252Ftransfer.php%253Faction%253Dbatch_download%2526batch_id%253DeURBdFdUb0JreER2Wmc9PQ Vraiment merci pour ton aide, car je sent que je suis proche du but. [Edité le 12/3/2011 par TiChan]

Bonsoir, Après avoir galérer toute la soirée (je n'ai pas de compétences) j'ai essayé de modifier le code de Maxence qui permet de remplir un tableau excel avec des attributs, mais pour avoir les propriétés des blocs dynamiques du dessin AutoCAD. Voici comment j'ai adapté la partie du code : (ça ne marche pas) J'ai essayer de faire ce que je pouvais avec la fonction mais comme je n'ai aucunes connaissances ni compétences en programmation, c'est chaud pour moi. Comment faire pour que cela marche? Voici un également un lien vers le bloc dynamique dont je souhaite pouvoir modifier les propriétés via excel : https://www.yousendit.com/download/eURCd0VLeFhQb0pjR0E9PQ Public Sub ExtraireAttributs() Dim AcadApp As AutoCAD.AcadApplication Dim SelSet As AutoCAD.AcadSelectionSet Dim FilterType(0) As Integer Dim FilterData(0) As Variant Dim FiltersType, FiltersData As Variant Dim i, Row, j, Column As Integer Dim Entity As AcadEntity Dim Blocref As AcadBlockReference Dim varPropDyn As Variant Dim ColumnExist As Boolean ' Efface toutes les données contenues dans la feuille Range("1:65536").ClearContents ' On demande le nom du fichier à ouvrir Dim Filename As Variant Filename = Application.GetOpenFilename("Dessins AutoCAD (*.dwg), *.dwg") If Filename = False Then Exit Sub End If Cells(1, 1).Value = Filename ' Connexion avec AutoCAD (on le lance si il n'est pas en cours d'exécution) On Error Resume Next Set AcadApp = GetObject(, "AutoCAD.Application") On Error GoTo 0 If AcadApp Is Nothing Then Set AcadApp = New AutoCAD.AcadApplication End If ' On ouvre le fichier DWG dans AutoCAD ou on l'active si il est déjà ouvert Dim Opened As Boolean Opened = False Dim Dwg As AcadDocument For Each Dwg In AcadApp.Documents If StrComp(Dwg.FullName, Cells(1, 1).Text, vbTextCompare) = 0 Then Dwg.Activate Opened = True End If Next If Not Opened Then AcadApp.Documents.Open (Cells(1, 1).Text) End If ' On remets Excel au premier plan (le lancement d'AutoCAD désactive la fenêtre Excel) Application.Visible = True ' Remplissage de l'entête du tableau Cells(3, 1).Value = "Nom du bloc" Cells(3, 2).Value = "Handle" Row = 4 ' 1ère ligne du tableau ' On crée un jeu de sélection ou on le récupère si il existe déjà On Error Resume Next Set SelSet = AcadApp.ActiveDocument.SelectionSets.Add("SELSET") If Err <> 0 Then Set SelSet = AcadApp.ActiveDocument.SelectionSets.Item("SELSET") SelSet.Clear End If ' On prépare un filtre de sélection sur les insertions de bloc FilterType(0) = 0 FilterData(0) = "INSERT" FiltersType = FilterType FiltersData = FilterData ' Sélection des entités SelSet.Select acSelectionSetAll, , , FiltersType, FiltersData ' On balaye le jeu de sélection For i = 0 To SelSet.Count - 1 Set Entity = SelSet.Item(i) ' Si l'objet est une insertion de bloc If Entity.ObjectName = "AcDbBlockReference" Then ' On précise le type de l'objet pour pouvoir accéder à ses propriétés et ' ses méthodes spécifiques Set Blocref = Entity ' Si il a des attributs If Blocref.HasAttributes Then Cells(Row, 1).Value = Blocref.Name Cells(Row, 2).Value = "'" & Blocref.Handle ' On les récupére varPropDyn = Bloc.GetDynamicBlockProperties ' On parcourt le tableau For j = LBound(varPropDyn) To UBound(varPropDyn) ' On recherche si une colonne existe déjà pour cette étiquette d'attribut Column = 3 ColumnExist = False While Not IsEmpty(Cells(3, Column)) If Cells(3, Column).Text = varPropDyn(j).PropertyName Then ' Une colonne existe, on la remplit avec la valeur de l'atribut Cells(Row, Column).Value = varPropDyn(j).Value ColumnExist = True End If Column = Column + 1 ' On passe à la colonne suivante Wend If Not ColumnExist Then ' Aucune colonne n'existe, on en crée une et on la remplit Cells(3, Column).Value = varPropDyn(j).TagString Cells(Row, Column).Value = varPropDyn(j).TextString End If Next ' Attribut suivant Row = Row + 1 ' Ligne suivante End If End If Next MsgBox "Les attributs du dessin " & Cells(1, 1).Text & " ont été extraits avec succès." End Sub [Edité le 9/3/2011 par TiChan]

Merci beaucoup! Si j'y arrive ça serait énorme! je tiens au jus.

l'outil est interressant mais ne répond que partiellement à mes attentes... En fait j'aimerai faire figurer dans l'export le paramètre "diamètre" que j'ai créé dans le bloc dynamique afin de pouvoir l'éditer depuis excel. Pour l'instant je n'arrive qu'a exporter des attributs avec les différentes méthodes et à les mettre à jour depuis excel. [Edité le 6/3/2011 par TiChan]

Merci pour ton aide, je vais regarder dans ce sens et je tien au jus! Je recherchai à améliorer le code vba du programme que j'avais trouvé sur le site de Maxence pour répondre à mon problème. Mais je suis ouvert à toute solution, là c'est le résultat qui compte.

N'y aurai t il personne qui pourrai m'aider? Avis aux pro du vba.