Connection libre office calc et Autocad

[John-cad]

Bonjour à tous

j'ai un problème avec un fichier de points enregistré avec calc de libre office extension ods

mon fichier calc est un fichier de points classique colonné avec Numéro X Y Z

j'ai fais sous calc libre office en VB une macro pour récupérer le contenu des cellules d'un fichier calc

 

je voudrais en VB sous libre office calc par une macro insérer un texte (numéro du point) aux coordonnées de celui-ci

j'avais la macro en VBA,je ne la retrouve plus et sous VB, je suis perdu

 

le but serait dans un premier temps dans la macro trouver le fichier ouvert avec AcadApplication je crois

puis d'insérer un texte avec AcadApp.ActiveDocument.ModelSpace.AddText en définissant l'index, le point d'insertion et une hauteur

 

Si vous avez des idées, merci par avance

[John-cad]

Bonjour

J'ai retrouvé la macro excel qui me permettait de faire un zoom en insérant un texte sous Autocad selon des coordonnées XYZ qui se trouvent dans une feuille de calcul excel

 

je voudrai passer cette macro sous calc de libre office

pour le moment j'arrive seulement à afficher un message box avec les informations d'un point Nuémro et XYZ

 

si vous avez des solutions pour passer d'une macro vba excel à une macro basic calc libre office,

voici le code en question qui marchait très bien sous vba excel

 

Sub Zoom

'Dim AcadApp As AcadApplication

'Dim Newlayer As AcadLayer
'Dim textStyle1 As AcadTextStyle
'Dim txt As String
'Dim NomModel As String
'Dim Ptxt As AcadText

Dim fichier as Object
Dim feuil as Object
Dim cell as Object
Dim row as Integer

Dim num as String
Dim ptx as Single
Dim pty as Single
Dim ptz as Single

'Set AcadApp = GetObject(, "AutoCAD.Application")

'   On Error GoTo 0
'  If AcadApp Is Nothing Then
'   Set AcadApp = New AutoCAD.AcadApplication
'   End If

fichier = ThisComponent
feuil = ThisComponent.Sheets.getByName(ThisComponent.CurrentController.ActiveSheet.Name)
cell = ThisComponent.CurrentSelection
row = cell.CellAddress.Row

'If cell.CellAddress.Column <> 1 Then MsgBox "Cette colonne n'est pas valide" Exit Sub


cell = feuil.getCellByPosition(0,row)
num = cell.Value
cell = feuil.getCellByPosition(1,row)
ptx = cell.Value
cell = feuil.getCellByPosition(2,row)
pty =cell.Value
cell = feuil.getCellByPosition(3,row)
ptz = cell.Value

MsgBox num & " - " & "X= " & ptx & " - Y= " & pty & " - Z= " & ptz

' Contrôle si Fichier Autocad dans Espace Object
'If NomModel <> "Model" Then MsgBox "Aucun point ne sera inséré dans l'espace papier.": Exit Sub
'If NomModel = "Model" Then
   
'Création du calque "ZOOM_PT" si absent
'Set Newlayer = AcadApp.ActiveDocument.Layers.Add("ZOOM_PT")
'AcadApp.ActiveDocument.SetVariable "CECOLOR", "1"
'AcadApp.ActiveDocument.ActiveLayer = Newlayer

'Création du style de texte "ZOOM_PT" si absent
'Set textStyle1 = AcadApp.ActiveDocument.TextStyles.Add("ZOOM_PT")
'textStyle1.fontFile = "C:\WINDOWS\Fonts\ARIAL.TTF"
'AcadApp.ActiveDocument.ActiveTextStyle = textStyle1
   
'Set Ptxt = AcadApp.ActiveDocument.ModelSpace.AddText(txt, point_txt, 1.25)
'Ptxt.Alignment = acAlignmentBottomCenter
'Ptxt.TextAlignmentPoint = point_txt
'ActiveCell.Interior.ColorIndex = "3"
'End If
'End If
   
'i = i + 1
'Acitve la cellule suivante
'Cells(i, j).Activate
'AcadApp.Visible = True
'Centre le zoom sur le texte
'AcadApp.ZoomCenter point_txt, 15
'Libère la mémoire de la varaible AcadApp
'Set AcadApp = Nothing

End Sub

 

j'ai mis pas mal de ' devant chaque ligne car sinon le programme n'arrête pas de planter sous calc

je mets en pièce jointe un exemple de fichier calc en question extension .ods

 

Merci par avance de votre aide

John

[John-cad]

Peut-être que ma question est débile mais j'essaye quand même

Si autocad accepte le vba d'Excel

Il ne doit peut-être pas accepter le basic de calc libre office

Cette question car dans le module macro vba de Microsoft on sélectionne les références de programme externe et librairies

Sous calc module macro en basic je n'ai pas encore trouver de sélectionner ces mêmes références

Quelqu'un les à t-il déjà vu en basic sous calc libre office ?

Car selon la réponse je ne continue même plus ce programme

Merci de vos retours

[x_all]

je ne suis pas féru en programmation, mais il me semble en effet qu'autodesk ne propose pas d'API autre que celle du partenariat qu'il à avec µcro$oft.

Tu as bien objectARX et ativeX respectivement pour le .net et le vba, mais pas grand chose du coté de l'opensource.

Peut être avec Pyton (qui se sert d'ActiveX) tu peu trouver une passerelle, mais pyautocad est très peu utilisé ici.

 

D'autres en savent plus s'ils ne sont pas en vacances, je voudrai pas dire top de bêtises...

[Lommig]

Bonjour,

Je trouve ton sujet très intéressant.

D'autant plus qu'apparemment, il n'existe pas de solution concrète sur Internet.

 

Après plusieurs essais (depuis ton premier message il y a un mois), j'ai trouvé une piste intéressante !

Mais je ne vais pas avoir le temps de l’approfondir... (je pars en vacances).

Donc je ne te propose pas la solution finale mais seulement mon début de code.

 

Pour l'instant, j'arrive à me connecter à AutoCAD (déjà ouvert), écrire un message en ligne de commande et régénérer le dessin.

 

1ère méthode:

 

Sub MAIN1()

 

Dim oleService

oleService = createUnoService("com.sun.star.bridge.OleObjectFactory")

Dim VBS

VBS = oleService.createInstance("MSScriptControl.ScriptControl")

VBS.Language = "VBScript"

 

Dim scr as String

scr=scr+" Public AcadApp "+Chr(10)

scr=scr+" Set AcadApp = GetObject(,""AutoCAD.Application"") "+Chr(10)

scr=scr+" Set AcadPlan = AcadApp.ActiveDocument "+Chr(10)

scr=scr+" AcadPlan.Utility.Prompt ""--- message 1 ---"" & vbCrLf "+Chr(10)

scr=scr+" AcadPlan.Regen acActiveViewport "+Chr(10)

 

VBS.ExecuteStatement(scr)

End Sub

 

2ème méthode:

 

Sub MAIN2()

 

Set VBS = CreateObject("MSScriptControl.ScriptControl")

VBS.Language = "VbScript"

 

scr=scr+" Sub T "+Chr(10)

scr=scr+" Dim AcadApp "+Chr(10)

scr=scr+" Set AcadApp = GetObject(,""AutoCAD.Application"") "+Chr(10)

scr=scr+" Set AcadPlan = AcadApp.ActiveDocument "+Chr(10)

scr=scr+" AcadPlan.Utility.Prompt ""--- message 2 ---"" & vbCrLf "+Chr(10)

scr=scr+" AcadPlan.Regen acActiveViewport "+Chr(10)

scr=scr+" End Sub "+Chr(10)

 

VBS.AddCode (scr)

VBS.Run ("T")

End Sub

 

Guillaume

[John-cad]

Bonjour Lommig

 

Merci tout d'abord pour ce début de code et désolé pour ma réponse tardive

j'étais débordé par le travail

en effet, en utlisant ta 1ere méthode, j'arrive depuis calc de libre office à créer quand Autocad est ouvert un nouveau calque mais dès que je veux lui faire insérer un texte ca plante et bien sûr je n'ai pas moyen de voir si c'est la variable qui fait défaut ou si c'est la commande en elle-même

 

ci-joint le bout de code que j'ai essayé

 

Sub zoom1()

Dim oleService
oleService = createUnoService("com.sun.star.bridge.OleObjectFactory")
Dim VBS
VBS = oleService.createInstance("MSScriptControl.ScriptControl")
VBS.Language = "VBScript"

Dim scr as String
Dim fichier as Object
Dim feuil as Object
Dim cell as Object
Dim row as Integer

Dim num as String
Dim ptx as Single
Dim pty as Single
Dim ptz as Single

fichier = ThisComponent
feuil = ThisComponent.Sheets.getByName(ThisComponent.CurrentController.ActiveSheet.Name)
cell = ThisComponent.CurrentSelection
row = cell.CellAddress.Row

cell = feuil.getCellByPosition(0,row)
num = cell.Value
cell = feuil.getCellByPosition(1,row)
ptx = cell.Value
cell = feuil.getCellByPosition(2,row)
pty =cell.Value
cell = feuil.getCellByPosition(3,row)
ptz = cell.Value

'MsgBox num & " " & ptx & " " & pty & " " & ptz


scr=scr+" Public AcadApp "+Chr(10)
scr=scr+" Set AcadApp = GetObject(,""AutoCAD.Application"") "+Chr(10)
scr=scr+" Set AcadPlan = AcadApp.ActiveDocument "+Chr(10)

' Création du calque d'insertion du texte zoom
scr=scr+" Set Newlayer = AcadApp.ActiveDocument.Layers.Add(""$ZOOM_PT"") "+Chr(10)
scr=scr+" AcadApp.ActiveDocument.SetVariable ""CECOLOR"", ""1"" "+Chr(10)
scr=scr+" AcadApp.ActiveDocument.ActiveLayer = Newlayer "+Chr(10)

scr=scr+" Set Ptxt = AcadApp.ActiveDocument.ModelSpace.AddText(num, point_txt, 1.25) "+Chr(10)
scr=scr+" Ptxt.Alignment = acAlignmentBottomCenter "+Chr(10)
scr=scr+" Ptxt.TextAlignmentPoint = point_txt "+Chr(10)


scr=scr+" AcadPlan.Regen acActiveViewport "+Chr(10)

VBS.ExecuteStatement(scr)

End Sub

 

je ne vois pas comment on peut définir le point_txt à partir des coordonnées lu dans calc depuis le curseur, peut être sous forme de liste comme en lisp.... je sais pas

 

pour résumer, dans mon fichier calc, j'ai des colonnes avec dans A le numéro du point, B l'abscisse, C l'ordonnée, D l'alimétrie

je voudrais pouvoir insérer dans Autocad directement depuis calc un texte (mon numéro de point en fait)

aux coordonnées XYZ de mon listing de points

je vais continuer à chercher de mon côté voir si je trouve quelque chose même si mes connaissances en VB sont plus que limitées

merci par avance de votre aide

John

[bryce]

Bonjour,

 

Ce serait sans doute plus simple de créer un script avec Calc, puis d'exécuter ce script dans AutoCAD.

Ci-joint un exemple assez proche de ce que tu veux faire. Le contenu de la colonne G peut être copié et collé directement dans la ligne de commande d'Autocad, ou bien dans un fichier texte avec une extension .scr puis exécuté ensuite dans AutoCAD.

plaque_percee.zip

[John-cad]

Bonjour à tous

 

désolé de ne pas avoir répondu plus tôt mais j'étais en plein déplacement professionnel

l'idée de départ était en fait de connecter calc de libreoffice avec autocad version pleine

n'étant pas un feru de programmation en basic ou vba, j'ai abandonné ce petit code basic et je l'ai réaliser en lisp tout court

par contre, pour des besoins professionnels, j'ai dû acquérir un autocad lt

acad lt ne supporte normalement ni le vba ni le lisp

 

mais pensez vous qu'on puisse tout de même piloter acadlt à partir de calc de libre office en language basic ?

et donc réaliser ce petit programme en basic de zoom au point à partir de calc

 

j'ai essayé le code décrit par lommig mais il n'y a pas de connexion possible à priori

 

Merci par avance de vos retours

John

[Invité NancyDup]

En effet ce logiciel tourne depuis quelque temps, il est surtout dédié à "Linux". Sous Windows il est moins stable quOpen office.

Mais le gratuit est toujours intéressant, à chacun de voir ce qui fonctionne le mieux sur son système

 

bon surf

[GEGEMATIC]

Salut,

Il doit y avoir plusieurs sujet lisp sur la liaison avec calc.

je donne ce code lisp, ou tout est d'origine .com

;******************************************************************************
;§/openoffice/ Ouvrir une feuille de calcul au format csv  spécifiée en utilisant l'API OOo pour VB / feuille
;;on peut définir avant (setq oOo-csv-separ ";")
;;site web de réference :
;;http://www.kalitech.fr/clients/doc/VB_APIOOo_fr.html
;
(defun OpenCsvWithoOOsCalc ( feuille / Oprop openPar)
(if (not feuille)
 (setq feuille (getfiled "Feuille de calcul à charger : " (getvar "dwgprefix") "csv" 0) )
)
(setq feuille  (strcat  "file:///" (pw_slashit feuille )))
;;;Set serviceManager = CreateObject("com.sun.star.serviceManager")
 (setq	serviceManager
 (vlax-create-object "com.sun.star.serviceManager")
 )
;;Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop")
 (setq	Desktop	(vlax-invoke-method
	  serviceManager
	  'createInstance
	  "com.sun.star.frame.Desktop"
	)
 )
 

;;;LoadParams:=VarArrayCreate([0,-1],varVariant);
 (setq openPar (vlax-make-safearray vlax-vbVariant '(0 . 2)))

;;;'On appelle la fonction setOOoProp définie précédemment pour récupérer la structure
;;;  Set OpenPar(0) = setOOoProp("ReadOnly", True)

;;;  ;(setq Oprop (setOOoProp "ReadOnly" :vlax-true))
 (setq Oprop (setOOoProp "ReadOnly" :vlax-false))
 (vlax-safearray-put-element openPar 0 Oprop)

;;;;;;  Set OpenPar(2) = setOOoProp("Hidden", False)
 (setq Oprop (setOOoProp "Hidden" :vlax-false))
 (vlax-safearray-put-element openPar 1 Oprop)

;;; - * - *
;; attention, ce qui suit est primordial pour ouvrir du csv avec openoffice:

 
;;;Dim oPropertyValue(0) As New com.sun.star.beans.PropertyValue
;;;oPropertyValue(0).Name = "FilterOptions"
;;;oPropertyValue(0).Value = "44"
;;;
;;;oDoc = starDeskTop.loadComponentFromURL( oUrl, "_blank", 0, oPropertyValue )
 (cond
   ((= oOo-csv-separ ",")
 (setq Oprop (setOOoProp "FilterOptions" "44"));_ 44 pour , car (ascii ",") = 44
    )
   ((= oOo-csv-separ ";")
    (setq Oprop (setOOoProp "FilterOptions" "59"));_59 pour ;
   )
   (t
 (setq Oprop (setOOoProp "FilterOptions" "44"));_ 44 pour , car (ascii ",") = 44
    )
   )
 
 (vlax-safearray-put-element openPar 2 Oprop)


 ;;;  ;;;mFileProperties(0).Name = "FilterName"
;;;  ;;;mFileProperties(0).Value = "scalc: Text - txt - csv (StarCalc)"
;;;  (setq Oprop (setOOoProp "FilterName" "scalc: Text - txt - csv (StarCalc)"))
;;;  (vlax-safearray-put-element openPar 3 Oprop)
;;;



;;;Set DocumentoOOo = Desktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, openPar)

 (Setq	DocumentoOOo
 (vlax-invoke-method
   Desktop	    'loadComponentFromURL
    feuille	     "_blank"
   0		    openPar
  )
 )
)