[Draw][Calc] Macro de dessins automatiques

Vos meilleures macros et portions de code sont publiées dans cette section.
Aucun support sur une question de programmation ici !

Modérateur: Vilains modOOs

Règles du forum
Aucune question dans cette section !
Celle-ci rassemble les meilleures macros et portions de code. Vous pouvez en revanche commenter ou argumenter le code exposé. Vous pouvez même remercier l'auteur (cela fait toujours plaisir) en indiquant par exemple dans quel cadre ou contexte vous en avez eu l'utilité.
Si vous avez à poster quelque chose, faites-le depuis la section Macros et API et demandez à un modérateur de l'y déplacer.

[Draw][Calc] Macro de dessins automatiques

Messagepar Sébastien C » 29 Avr 2008 18:39

Très surpris par le fait que les macros déposées en ce lieu ne soient pas plus relatives à Draw. Et pourtant ; on imagine mal les possibilités extraordinaires qu’elles permettent, parfois très simplement.

Dans le cadres de mon métier (facteur d’orgues), je dois dessiner des plans à l’échelle comportant un grand nombre de cercles ou de carrés, tous de tailles différentes. La détermination des cotes de ces carrés ou de ces cercles (qui sont des sections de tuyaux) se fait sans le moindre problème avec Calc. Mais en avoir automatiquement une représentation graphique que l’on puisse manipuler et placer sur un plan est évidemment extrêmement avantageux.

Depuis Calc, on sélectionne les valeurs, puis on lance la macro et un nouveau document Draw est créé contenant les cercles ou les rectangles (selon la sélection effectuée).

Pour être extrêmement simple, la macro laisse envisager une foultitude d’applications basées sur le même principe de stockage des valeurs dans Calc avec leur application graphique dans Draw. C’est ainsi que, sur ce même principe, on peut imaginer construire des types de graphiques qui n’existent pas dans Calc et qui, surtout, peuvent tracer des objets cotés à l’échelle de façon à être imprimés très précisément.

La macro :
Code : Tout sélectionner   AgrandirRéduire
' *** Mode d'emploi ***
' La macro doit s'exécuter sous Calc.
' Sélection des cellules.
' Étiquettes des noms de notes dans la colonne de gauche.
' Si deux colonnes sont sélectionnées au total (étiquettes + une colonne de données) alors, ce sont des cercles.
' Si trois colonnes sont sélectionnées au total (étiquettes + deux colonne de données) alors, ce sont des rectangles.

sub traceTuyaux()
Dim monDocument As Object
Dim propFich()

    monDocument = ThisComponent
      maFeuille = monDocument.CurrentController.ActiveSheet
    maSelection = monDocument.getCurrentSelection()
      mesLignes = maSelection.Rows.Count
    mesColonnes = maSelection.Columns.Count
   monDepartCol = maSelection.RangeAddress.StartColumn
   monDepartLig = maSelection.RangeAddress.StartRow

  Dim valeur(mesColonnes, mesLignes) As String

  ' Vérification de la sélection.
   if ((mesColonnes < 2) or (mesColonnes > 3)) then                                     ' Nombre de colonne inadapté.
    MsgBox ("La sélection DOIT comporter 2 ou 3 colonnes." ,16)
    Exit Sub
   end if


  ' Lecture et mise en mémoire des cellules de la sélection.
  For i = 0 to (mesLignes - 1)
   valeur(0, i) = maFeuille.GetCellByPosition(monDepartCol, monDepartLig + i).String   ' Étiquette.
   For j = 1 to (mesColonnes - 1)
    valRound = maFeuille.GetCellByPosition(monDepartCol + j, monDepartLig + i).Value   ' Valeur numérique
    valeur(j, i) = str((Cint(valRound * 10) / 10))                                     ' arrondie au dixième.
   Next j
  Next i

  ' Ouvre un nouveau document Draw.
  monDessin = StarDesktop.LoadComponentFromURL("private:factory/sdraw", "_blank", 0, propFich)

  Dim maPage As Object, maForme As Object, monTexte As Object
  Dim dimensionsForme as New com.sun.star.awt.Size
  Dim positionForme as New com.sun.star.awt.Point

  maPage = monDessin.DrawPages(0)                                                      ' 0 est la première page.
  x = 10 : y = 10                                                                      ' Position de départ des formes

' Traçage des formes.
For i = 0 to (mesLignes - 1)
  largeur = val(valeur(1, i))

  ' Définition du type des formes.
  if mesColonnes = 2 then                                                              ' Cercle.
   hauteur = largeur
   maForme = monDessin.createInstance("com.sun.star.drawing.EllipseShape")
   maForme.CircleKind = com.sun.star.drawing.CircleKind.FULL

  elseif mesColonnes = 3 then                                                          ' Rectangle
   hauteur = val(valeur(2, i))
   maForme = monDessin.createInstance("com.sun.star.drawing.RectangleShape")

  end if

   dimensionsForme.Width = largeur * 100 : dimensionsForme.Height = hauteur * 100 : maForme.Size = dimensionsForme
         positionForme.x = x * 100 :              positionForme.y = y * 100 :   maForme.Position = positionForme

  maForme.FillStyle = com.sun.star.drawing.FillStyle.NONE
  maPage.add(maForme)

  monTexte = maForme.Text
    chaine = valeur(0, i)

  ' Remplacement de la chaîne « \n » par un saut de ligne chr(13).
  while instr(chaine, "\n") > 0
   posChaine = instr(chaine, "\n")
   chaine = left(chaine, (posChaine - 1)) & chr(13) & right(chaine, len(chaine) - (posChaine + 1))
  Wend

  monTexte.String = chaine
  monTexte.CharHeight = 10

  x = x + 3 : y = y + 3                                                                ' Décalage de la position des formes (en mm.) pour pouvoir plus aisément saisir les objets.
next i
end sub


et le fichier Calc qui va avec : https://forum.openoffice.org/fr/ci-joint/fichier/2008/04/29-073258.ods.
LibreOffice 3.5.3.2 sous GNU-Linux Mageia 2.
Avatar de l’utilisateur
Sébastien C
Membre hOOnoraire
Membre hOOnoraire
 
Message(s) : 157
Inscrit le : 29 Avr 2008 00:21
Localisation : Meymac (19250)

Retour vers Suprême de code

Qui est en ligne ?

Utilisateur(s) parcourant ce forum : Aucun utilisateur inscrit et 2 invité(s)