Acad et OpenOffice

[winfield]

Bonsoir,

C'est pour faire suite au sujet ci-après http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=4707#pid54382

 

Voici une petite contribution à mon niveau.

Bien sûr, c'est pour ceux qui n'ont pas/ne veulent pas du pack Office.

 

Cette routine extrait les attributs des blocs dans Calc (tableur d'OpenOffice)

 

1ere colonne =n° Handle

2ème colonne = Nom du bloc

3ème colonne=Etiquette d'attribut

4ème colonne=Valeur d'attributs ( même si le bloc a plusieurs attributs)

 

(c'est mieux quand le fichier dwg est enregistré, comme ça, le fichier Calc peut être enregistré automatiquement)

 

 
Sub ExportAttributs_OOOo()

   Dim ObjSelection As AcadSelectionSet
   Dim StrSelection As String
   
   StrSelection = "MaSelection"
   
   On Error Resume Next

   Set ObjSelection = ThisDrawing.SelectionSets(StrSelection)
   If Err <> 0 Then
       Err.Clear
       Set ObjSelection = ThisDrawing.SelectionSets.Add(StrSelection)
   End If
   ObjSelection.Clear
   
   Dim DataCodeDxf(1) As Variant
   Dim CodeDxf(1) As Integer
   
   CodeDxf(0) = 0: DataCodeDxf(0) = "INSERT"
   CodeDxf(1) = 66: DataCodeDxf(1) = 1
   
   ObjSelection.Select acSelectionSetAll, , , CodeDxf, DataCodeDxf
   
   If ObjSelection.Count = 0 Then
       ObjSelection.Delete
       MsgBox "Il n'y a pas de blocs avec attributs dans ce dessin", vbInformation, "Abandon"
       Exit Sub
   End If
   
   Dim serviceManager As Object
   Dim Desktop As Object, DocumentoOOo As Object
   Dim args()
   Dim ObjCalc As Object
   
   Set serviceManager = CreateObject("com.sun.star.serviceManager")
   Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")
   Set DocumentoOOo = Desktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, args)
   Set ObjCalc = DocumentoOOo.Sheets().getByIndex(0)
   
   ObjCalc.GetCellByPosition(0, 0).SetString ("Hand")
   ObjCalc.GetCellByPosition(1, 0).SetString ("Nom bloc")
   ObjCalc.GetCellByPosition(2, 0).SetString ("Etiquette")
   ObjCalc.GetCellByPosition(3, 0).SetString ("Valeur")
   
   Ligne = 1
   For n = 0 To ObjSelection.Count - 1
       Ligne = Ligne + 1
       VarAttribut = ObjSelection(n).GetAttributes
       ObjCalc.GetCellByPosition(0, Ligne).SetString (ObjSelection(n).Handle)
       ObjCalc.GetCellByPosition(1, Ligne).SetString (ObjSelection(n).Name)
       For i = LBound(VarAttribut) To UBound(VarAttribut)
           ObjCalc.GetCellByPosition(2, Ligne).SetString (VarAttribut(i).TagString)
           ObjCalc.GetCellByPosition(3, Ligne).SetString (VarAttribut(i).TextString)
           Ligne = Ligne + 1
       Next
   Next
   If ThisDrawing.FullName <> "" Then
       Chemin = ThisDrawing.FullName
       Chemin = Replace(Chemin, "\", "/")
       Chemin = Replace(Chemin, "dwg", "ods")
       DocumentoOOo.StoreAsURL "file:///" & Chemin, args
   End If
End Sub

Et comme il faut un retour :cool: (Calc=>Acad)

 

 
Sub ImportAttributs_OOOo()

   Dim serviceManager As Object
   Dim Desktop As Object, DocumentoOOo As Object
   Dim ObjCalc As Object
   Dim Chemin As String
   Dim AffichageoOOo(0)
   
   If ThisDrawing.FullName <> "" Then
       Chemin = "file:///" & ThisDrawing.FullName
       Chemin = Replace(Chemin, "\", "/")
       Chemin = Replace(Chemin, "dwg", "ods")
   Else
       MsgBox "Il n'y a pas de fichier Calc pour ce dessin." & Chr(13) _
       & "Le nom du fichier Calc doit avoir le même nom que le fichier dwg" & Chr(13) _
       & "et doit se trouver dans le même répertoire.", vbInformation, "Fichier Calc manquant"
       Exit Sub
   End If
  
   Set serviceManager = CreateObject("com.sun.star.serviceManager")
   Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")
   Set AffichageoOOo(0) = serviceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
   
   AffichageoOOo(0).Name = "Hidden"
   AffichageoOOo(0).Value = True
   
   Set DocumentoOOo = Desktop.loadComponentFromURL(Chemin, "_blank", 0, AffichageoOOo())
   Set ObjCalc = DocumentoOOo.Sheets().getByIndex(0)
   
   NumLigne = 2
   fin = False
   Do
       hand = ObjCalc.GetCellByPosition(0, NumLigne).String
       Set ObjectTemp = ThisDrawing.HandleToObject(hand)
       VarAttribut = ObjectTemp.GetAttributes
       While ObjCalc.GetCellByPosition(2, NumLigne).String <> ""
           For n = LBound(VarAttribut) To UBound(VarAttribut)
               If ObjCalc.GetCellByPosition(2, NumLigne).String = VarAttribut(n).TagString Then
                   VarAttribut(n).TextString = ObjCalc.GetCellByPosition(3, NumLigne).String
                   VarAttribut(n).Update
               End If
           Next
           NumLigne = NumLigne + 1
       Wend
       NumLigne = NumLigne + 1
       If ObjCalc.GetCellByPosition(2, NumLigne).String = "" And ObjCalc.GetCellByPosition(2, NumLigne + 1).String = "" Then
           fin = True
       End If
   Loop While fin = False
   DocumentoOOo.dispose
   
End Sub   

 

Voilà ! J'espère que ça pourra aider certains d'entre vous.

[fabcad]

Super y aurait-il la même chose en Vlisp ?

Pour le fun

 

merci

 

Fabcad

[Steven]

Alors je dis BRAVO!

Parce que j'en ai marre qu'on parle toujours du pack office de crosoft ou de crosoft tout court.

Pouvoir utiliser AutoCAD avec autre chose que du crosoft, j'adore :D

Merci winfield ;)

[winfield]

Je vous remercie d'avoir testé et je suis content que ça vous plaise

 

Prochaine étape, Base ? :casstet:

 

[speedy]

Bonjour à tous

 

et un grand merci à Winfield, je recherche déséspérement, le code vba qui fonctionne depuis excel comme celui de Maxence delanoy import des attributs depuis excel et export je l'ai mis en ligne pour réparer l'erreur, la partie import depuis excel je suis arrivé à le faire mais export je plante toujours....

 

voir sujet : http://www.cadxp.com/sujetXForum-13635.htm

 

Merci d'avance

 

Michel a

[Patrick_35]

Salut

Regarde ce sujet.

Tu as un lisp qui travaille entre Excel et autocad dans les deux sens. Le vlisp étant assez proche du vba, je pense que tu pourras faire la traduction.

 

@+

[winfield]

je recherche déséspérement, le code vba qui fonctionne depuis excel comme celui de Maxence delanoy import des attributs depuis excel

 

Je l'ai déjà dit, le code de Maxence fonctionne très bien. Il te faut juste charger la bonne bibliothèque.

Le sujet a d'ailleur été traité sur ce post

http:// http://www.cadxp.com/sujetXForum-11717.htm

Bonne journée

[speedy]

Merci à vous tous

 

ça marche, et en plus j'avais regardé et je n'avais pas remarqué la bybliothèque manquante...

 

A+

 

Michel a

[sechanbask]

Ça fait quelque temps que je cherchais un macro comme ça. Sauf que l'on ne peut pas considérer l'extraction comme un base de données donc c'est un peu dommage. Quand j'aurais du temps (à la retraite) j'essayerais de le faire...

[winfield]

Sauf que l'on ne peut pas considérer l'extraction comme un base de données donc c'est un peu dommage

Tous le monde sait qu'un tableur n'est pas une base de données mais là, va falloir m'expliquer un peu plus, car je n'ai pas compris où tu veux en venir.

[sechanbask]

désolé pour les fautes et abréviations mais je me suis coupé à l'intérieur de la main gauche alors je ne tape qu'avec la main droite...(promis je rendrais ça lisible pour tous quand les points de suture ne me feront plus mal)

 

Je modifie un peu le code que tu avais fait et posté (merci pour ta contribution) pour permettre de faire des tris ou requêtes SQL. il manquait également quelques déclarations. voilà pour extraction : calc to autocad suivra si j'ai un peu de temps :

 

Option Explicit
Sub ExportAttributs_OOOo()
Dim ligne As Integer
Dim i As Integer
Dim n As Integer
Dim varAttribut As Variant
Dim ObjSelection As AcadSelectionSet
Dim StrSelection As String
Dim chemin As String

StrSelection = "MaSelection"

On Error Resume Next

Set ObjSelection = ThisDrawing.SelectionSets(StrSelection)
If Err <> 0 Then
Err.Clear
Set ObjSelection = ThisDrawing.SelectionSets.Add(StrSelection)
End If
ObjSelection.Clear

Dim DataCodeDxf(1) As Variant
Dim CodeDxf(1) As Integer

CodeDxf(0) = 0: DataCodeDxf(0) = "INSERT"
CodeDxf(1) = 66: DataCodeDxf(1) = 1

ObjSelection.Select acSelectionSetAll, , , CodeDxf, DataCodeDxf

If ObjSelection.Count = 0 Then
ObjSelection.Delete
MsgBox "Il n'y a pas de blocs avec attributs dans ce dessin", vbInformation, "Abandon"
Exit Sub
End If

Dim serviceManager As Object
Dim Desktop As Object, DocumentoOOo As Object
Dim args()
Dim ObjCalc As Object

Set serviceManager = CreateObject("com.sun.star.serviceManager")
Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")
Set DocumentoOOo = Desktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, args)
Set ObjCalc = DocumentoOOo.Sheets().getByIndex(0)

ObjCalc.GetCellByPosition(0, 0).SetString ("Hand")
ObjCalc.GetCellByPosition(1, 0).SetString ("Nom bloc")
ObjCalc.GetCellByPosition(2, 0).SetString ("Etiquette")
ObjCalc.GetCellByPosition(3, 0).SetString ("Valeur")

ligne = 1
For n = 0 To ObjSelection.Count - 1
'ligne = ligne + 1
varAttribut = ObjSelection(n).GetAttributes

For i = LBound(varAttribut) To UBound(varAttribut)
ObjCalc.GetCellByPosition(0, ligne).SetString (ObjSelection(n).Handle)
ObjCalc.GetCellByPosition(1, ligne).SetString (ObjSelection(n).Name)
ObjCalc.GetCellByPosition(2, ligne).SetString (varAttribut(i).TagString)
ObjCalc.GetCellByPosition(3, ligne).SetString (varAttribut(i).TextString)
ligne = ligne + 1
Next i
Next n
If ThisDrawing.FullName <> "" Then
chemin = ThisDrawing.FullName
chemin = Replace(chemin, "\", "/")
chemin = Replace(chemin, "dwg", "ods")
DocumentoOOo.StoreAsURL "file:///" & chemin, args
End If
End Sub

[speedy]

Bonsoir sechanbask

ton VBA fonctionne, peux tu lui rajouter les coordonnées xyz et est ce possible de faire l'inverse (mise à jour depuis OOOo vers autocad ???).

 

@+

 

Michel a

 

 

[sechanbask]

attendez un peu,

je suis blessé et j'ai un boulot monstre pendant le prochain mois (2 collègues en vacances etc.), alors ça risque d'être long, désolé.

 

L'idéal pour moi, ça serait de faire un ligne par bloc avec plein de colonnes pour les différents attributs pour les blocs... mais bon ça se discute.

 

[Edité le 8/7/2007 par sechanbask]

[winfield]

.....fallait faire un couper-coller des lignes du code, pas celles de ta main !

[sechanbask]

j'ai eu un peu de mal à comprendre ta blague mais j'en ai ri aux éclats !!