excel to autocad

[speedy]

Bonjour à tous

 

j'ai récuperer ce code source que j'ai modifié, je n'arrive pas à faire fonctionner l'inverse excel to autocad ??? pourriez vous m'aider à l'améliorer .....voir la seconde partie plus bas....

 

Public Sub Extraire_Attributs()

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

 

'modifié par Michel a

' Efface toutes les données contenues dans la feuille

Range("1:65536").ClearContents

 

' On lance AutoCAD

Set AcadApp = New AutoCAD.AcadApplication

 

' On remets Excel au premier plan (le lancement d'AutoCAD désactive la fenêtre Excel)

Application.Visible = True

 

' On demande le nom du fichier à ouvrir

Cells(1, 1).Value = Application.GetOpenFilename("Dessins AutoCAD (*.dwg), *.dwg")

 

' Remplissage de l'entête du tableau

Cells(3, 1).Value = "Nom du bloc"

Cells(3, 2).Value = "Handle"

Cells(3, 6).Value = "X"

Cells(3, 7).Value = "Y"

Cells(3, 8).Value = "Z"

Cells(3, 9).Value = "Echelle X"

Cells(3, 10).Value = "Echelle Y"

Cells(3, 11).Value = "Echelle Z"

Cells(3, 12).Value = "Rotation"

Cells(3, 13).Value = "Calque"

 

 

' On ouvre le fichier dans AutoCAD

AcadApp.Documents.Open (Cells(1, 1).Text)

 

Row = 4 ' 1ère ligne du tableau

 

' On crée un jeu de sélection

Set SelSet = AcadApp.ActiveDocument.SelectionSets.Add("SELSET")

 

' 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

Cells(Row, 1) = BlocRef.Name

Point = BlocRef.InsertionPoint

Cells(Row, 6) = Point(0)

Cells(Row, 7) = Point(1)

Cells(Row, 8) = Point(2)

Cells(Row, 9) = BlocRef.XScaleFactor

Cells(Row, 10) = BlocRef.YScaleFactor

Cells(Row, 11) = BlocRef.ZScaleFactor

Cells(Row, 12) = BlocRef.Rotation

Cells(Row, 13) = BlocRef.Layer

 

 

' 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

 

Row = Row + 1 ' Ligne suivante

End If

End If

Next

 

' On ferme AutoCAD

AcadApp.Quit

 

MsgBox "Les attributs du dessin " & Cells(1, 1).Text & " ont été extraits avec succès."

End Sub

-------------------------------------------

 

Sub EnvoyerVersAutoCAD()

Dim AcadApp As AutoCAD.AcadApplication

Dim BlocRef As AcadBlockReference

Dim Row, i, Column As Integer

 

' On lance AutoCAD

Set AcadApp = New AutoCAD.AcadApplication

AcadApp.Visible = True

 

' On ouvre le fichier dans AutoCAD

AcadApp.Documents.Open (Cells(1, 1).Text)

 

Row = 4 ' On commence à la rangée N°4

 

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

Set BlocRef = AcadApp.ActiveDocument.HandleToObject(Cells(Row, 2))

 

' 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

 

BlocRef.Update

End If

Row = Row + 1 ' On passe à la ligne suivante

Wend

 

'AcadApp.ActiveDocument.Regen(acActiveViewport)

 

' On ferme AutoCAD

AcadApp.Quit

 

MsgBox "Les données ont été transférées vers AutoCAD avec succès."

 

End Sub

 

Merci de votre aide

 

Michel a

[didier]

hello,

 

j'aime assez le VBA pour m'y essayer,

mais j'ai besoin de savoir ce qu'on va trouver

dans le fichier Excel pour commencer.

 

manque de temps, mais je vais voir.

amicalement

[speedy]

Bonsoir Didier

 

dans le premier code vba, il importe les infos des blocs x,y,z et attributs avec le handle, dans un tableau excel, et j'aimerais pouvoir faire une mise à jour et exporter vers autocad de la même manière, comme excellink (je ne suis pas arrivé à le faire fonctionner).

 

je préfère avoir un fichier excel Autonome pour gérer mes données.

 

 

Michel a

 

[didier]

hello,

donc, tu as un fichier AutoCad qui contient des blocs avec attributs
de ce fichier, tu extrais les données pour créer un fichier Excel

ensuite, tu rentres via Excel dans ce fichier (xls)
tu changes, par exemple, des valeurs d'attributs
et tu souhaites mettre le fichier dwg à jour avec ces nouvelles valeurs ?

Si c'est ça, merci de confirmer.

 

 

[speedy]

Bonjour

 

C'est exactement ça Didier........

 

 

Merci de ton aide

 

Michel a

[punky0147]

ce post est-il toujours en suspent ?

[zkouba]

:casstet: salut tout le monde!

 

je reste patient ..j'attend toujours la réponse ....Merci A+

[speedy]

Bonjour

le code vba de excel ci dessus fonctionne très bien il faut juste un peu l'améliorer.....

ne pas oublier de déclarer la biblio dans préférence de l'éditeur vba.

 

@+

 

Michel a