Envoyer dans Access

[jalna]

Bonjour,

 

Comment envoyer (récuperer) des données AutoCAD et les envoyés dans Access?

 

Faut il passé par les connections BD ou par du VBA?

 

Une fois envoyé dans Access peut on les réinjecter dans AutoCAD?

 

Merci à vous...................

[papyrus1985]

Salut,

 

Quel genre de donnée tu veux envoyer ?

[jalna]

Salut!

En fait cela peut être des attributs, du texte,

Tu as une piste!

[papyrus1985]

Salut,

 

Je me souvient avoir fais une routine avec les "dde" dans autocad pour lier dans objet a une bdd access je vais essayer de te le trouver ce w-e

[jalna]

Ok papyrus

Merci en attendant

Bon week end

[OtObOx]

Salut,

 

Pour ta deuxième question données de Access vers AutoCAD, j'ai pas de solution à t'apporter, je ne pense pas que ça soit trop compliqué, mais je ne l'ai jamais fait.

 

Pour ta première question, j'ai quelque chose : il y a quelques temps de cela, j'avais fait une macro vba sous AutoCAD 2005 qui exportait dans un base Access 97 tous les text et mtext que pouvait contenir un dessin. (les dessins étaient en anglais et j'exportais les mots en anglais pour les traduire en français. J'avais un lexique par plan et les mots qui revenaient régulièrement d'un dessin sur l'autre était traduits automatiquement au fur et a mesure que la base s'enrichissait).

 

Dans cette base TextesDessins.mdb, il y a 3 tables :

tabFichiers où sont stockés les noms et chemins des différents dessins traités.

tabExpAng où sont stockés les textes extraits du dessin

tabCorrespondance où sont stockés le numéro unique access (la clé de l'enregistrement de la table tabExpAng) du texte extrait du dessin

 

Il y a aussi dans cette macro une fonction qui supprime les combinaisons de caractère tels que %%U pour indiquer souligner etc.

 

Je commente assez abondamment mon code, j'espère que tu comprendras :

 

 

Private Sub ExtractionTextes()
'Déclaration des variables :
Dim sset As AcadSelectionSet 'variable du type "jeu de sélection AutoCAD"
Dim gpCode(0) As Integer 'Déclaration d'une variable tableau avec 3 lignes car on a 3 critères de sélection
Dim dataValue(0) As Variant 'Déclaration d'une variable tableau correspondant aux paramètres du tableau gpcode
Dim groupCode As Variant
Dim dataCode As Variant
Dim acadObj As Variant
Dim intPosition As Integer
Dim strTexte As String
Dim strBase As String 'Chemin vers la base de donnée
Dim db As DAO.Database
Dim rst As Recordset
Dim rstRech As Recordset
Dim rstCorr As Recordset
Dim idPlan As Long
Dim idExpAng As Long


On Error GoTo gestErr 'Si VBA rencontre une erreur en cours d'exécution, aller au gestionnaire d'erreur

'Chemin vers la base de données
strBase = "C:\Documents and Settings\Jean-Marc\Mes documents\Macros VBA\Essai layers\TextesDessins.mdb"

'Création de l'objet base de données :
Set db = Nothing
Set db = OpenDatabase(strBase)

'Renseignement de la base : complète la table tabPlan
Set rst = db.OpenRecordset("tabFichiers")
rst.AddNew
rst.Fields(1) = ThisDrawing.Name
rst.Fields(4) = ThisDrawing.FullName
'Lecture du idPlan nouvellement créé :
idPlan = rst.Fields(0)
'Enregistrement du recordset
rst.Update
'Fermeture du recordset
rst.Close
Set rst = Nothing


'Creation du jeu de sélection "JeuSel1"
'Si le jeu de sélection "JeuSel1" existe déjà, il y aura une erreur:
'VBA ira sur le gestionnaire d'erreur avant de revenir à la ligne suivante
Set sset = ThisDrawing.SelectionSets.Add("JeuSel")

'Sélection des textes simple ligne
gpCode(0) = 0 'Type de sélection : 0= entité
dataValue(0) = "TEXT" 'Type d'entité : Texte simple
groupCode = gpCode
dataCode = dataValue
sset.Select acSelectionSetAll, , , groupCode, dataCode

'Puis ajout à la sélection des textes multilignes
gpCode(0) = 0 'Type de sélection : 0= entité
dataValue(0) = "MTEXT" 'Type d'entité : Texte multiligne
groupCode = gpCode
dataCode = dataValue
sset.Select acSelectionSetAll, , , groupCode, dataCode

'Ouvre les objets recordsets :
Set rst = db.OpenRecordset("tabExpAng")
Set rstCorr = db.OpenRecordset("tabCorrespondance")
'Parcourir la sélection pour extraire le texte
For Each acadObj In sset
   strTexte = acadObj.TextString
   If Left$(strTexte, 2) = "{\" Then 'Signe d'un texte multi
       intPosition = TInstrRev(strTexte, ";")
       strTexte = Mid$(strTexte, intPosition + 1, Len(strTexte) - intPosition - 1)
   End If
   If Left$(strTexte, 2) = "%%" Then 'Zapper le %%x indiquant un soulignement ou autre habillage de texte
       strTexte = Right$(strTexte, Len(strTexte) - 3)
   End If
   If Not IsNumeric(strTexte) Then
       'Vérifier que l'expression n'existe pas dans la table ExpAng:
       Set rstRech = db.OpenRecordset("tabExpAng", dbOpenDynaset)
       rstRech.FindFirst ("ExpAng = '" & strTexte & "'")
       If rstRech.NoMatch Then 'Si l'expression n'est pas dans la table
           rst.AddNew
           rst.Fields(1) = strTexte
           idExpAng = rst.Fields(0)
           rst.Update
           'Mettre à jour la table des correspondances :
           rstCorr.AddNew
           rstCorr.Fields(1) = idPlan
           rstCorr.Fields(2) = idExpAng
           rstCorr.Update
       Else 'Sinon, ne complèter que la table des correspondances
           rstCorr.AddNew
           rstCorr.Fields(1) = idPlan
           rstCorr.Fields(2) = rstRech.Fields(0)
           rstCorr.Update
       End If
       rstRech.Close
   End If
Next acadObj

'Fermeture des rst
rst.Close
rstCorr.Close
'Avant de quitter la procédure, on efface l'objet "sset"
Set sset = Nothing
'puis on efface le jeu de sélection de la mémoire :
ThisDrawing.SelectionSets.Item("JeuSel").Delete

'Fermeture de la base access
db.Close
'Et effacement de la mémoire de l'objet Access
Set db = Nothing

'Fin de l'exécution ici :
Exit Sub 'On quitte la procédure


gestErr: 'Ici commence le gestionnaire d'erreurs

If err.Number = -2145320851 Then 'Si le code d'erreur correspond à celui d'un jeu de sélection déjà existant
   ThisDrawing.SelectionSets.Item("JeuSel").Delete 'Alors on efface le jeu de sélection de la mémoire
   Set sset = ThisDrawing.SelectionSets.Add("JeuSel") 'Puis on recrée un nouveau jeu de sélection
   Resume Next 'Et on repart à la ligne qui suit celle qui a engendré l'erreur
Else 'Sinon
   MsgBox err.Number & " : " & err.Description 'indiquer le code d'erreur et sa description
   Exit Sub 'puis quitter la procédure
End If
End Sub


Private Function TInstrRev(Texte As String, cherche As String, _
Optional Start As Integer = 0, _
Optional Comparaison As Integer = vbTextCompare) _
As Integer

On Error GoTo err
If Start < 1 Then Start = Len(Texte)
Texte = Right(Texte, Start)
While InStr(TInstrRev + 1, Texte, cherche, Comparaison) > 0
TInstrRev = InStr(TInstrRev + 1, Texte, cherche, Comparaison)
Wend
Exit Function
err:
MsgBox "Vérifier vos paramètres", vbCritical, "Fonction TInstrRev"
End Function

 

J'ai aussi quelque part dans mes backup un code qui permet à partir d'Access d'ouvrir un dessin AutoCAD et parcourir les blocs à la recherche de blocs définissant des cartouches, puis récupérer leurs attributs pour les stocker dans une table. Si ça t'intéresse, fais moi signe.

 

Bonne chance

 

JM