Tableaux

[tyrese69_]

Bonjour à tous,

J'ai un tableau que je génère automatiquement, mais le style initial du tableau donne une hauteur de ligne lambda, puis en le remplissant j'ajuste les hauteurs selon, titre sous-titre et autres lignes.

En fin de remplissage mes textes sont plus grands que ce que je souhaite !

Ils débordent de ma longueur de ligne.

 

Pour avoir les bonnes valeur il faut que je clique sur le tableau et que je lise une valeur, alors tout rentre dans l'ordre ?? Mais la hauteur reste à celle précédente (avec le débordement)

 

Je dois mal régénérer l'afichage !

 

 

Par contre, dans le menu contextuel il y "uniformisé les hauteurs de ligne". Cette fonction est elle accessible en VBA ?

 

Bonne fin de journée !

 

Daniel OLIVES

 

[sechanbask]

afin de nettoyer des plans, j'ai tenté d'accèder aux propriétés des tableaux mais en vain...

 

Bon courage... si tu trouves pense à moi

[tyrese69_]

Hi,

Voici les petites routines de base qui m'ont permis de démarrer avec les tables !

 

Option Explicit

 

'Code de groupe Description

 

' 0 Nom d 'entité (ACAD_TABLE)

' 5 Identificateur d 'entité

' 330 ID pointeur logiciel du dictionnaire propriétaire

' 100 Marqueur de sous-classe. Il existe trois sous-classes de marqueurs

' dans l'ordre suivant : AcDbEntity, AcDbBlockReference, AcDbTable

' 92 nombre d 'octets dans les graphiques de l'entité externe

' 310 Données des graphiques de l'entité externe (lignes multiples

' ; 256 caractères maximum par ligne)

' 2 Nom de bloc ; un bloc anonyme commence par la valeur *T.

'10,20,30 Point d 'insertion

' 342 ID de pointeur matériel de l'objet TABLESTYLE

' 343 ID de pointeur matériel de l'enregistrement BLOCK parent

'11,21,31 Vecteur de direction horizontale

' 90 Drapeau de valeur de table (entier non signé)

' 91 Nombre de rangées

' 92 Nombre de colonnes

' 93 Drapeau pour un remplacement

' 94 Drapeau pour un remplacement de couleur de bordure

' 95 Drapeau pour un remplacement d'épaisseur de ligne de bordure

' 96 Drapeau pour un remplacement de visibilité de bordure

' 141 Hauteur de rangée ; cette valeur est répétée, 1 valeur par rangée.

' 142 Hauteur de colonne ; cette valeur est répétée, 1 valeur par rangée.

' 171 Type de cellule ; cette valeur est répétée, 1 valeur par cellule

'1 = Type texte

'2 = Type bloc

' 172 Valeur de drapeau de cellule ; cette valeur est répétée, 1 valeur par cellule.

' 173 Valeur de cellule fusionnée ; cette valeur est répétée, 1 valeur par cellule.

' 174 Drapeau booléen indiquant si l'option d'ajustement automatique est définie

' pour la cellule ; la valeur est répétée, 1 valeur par cellule.

' 175 Largeur de bordure de cellule (applicable aux cellules fusionnées uniquement) ;

' cette valeur est répétée, 1 valeur par cellule.

' 176 Hauteur de bordure de cellule (applicable aux cellules fusionnées uniquement) ;

' cette valeur est répétée, 1 valeur par cellule.

' 177 Drapeau de remplacement de cellule ; cette valeur est répétée, 1 valeur par

' cellule.

' 178 Valeur de drapeau pour une arête virtuelle

' 145 Valeur de rotation (réel ; applicable à une cellule de type bloc et à une

' cellule de type texte)

' 344 ID de pointeur matériel de l'objet FIELD Applicable à une cellule de type texte

' uniquement. Si le texte de la cellule contient un ou plusieurs champs, seul

' l'ID de l'objet FIELD est enregistré. La chaîne de texte (codes de groupe 1

' et 3) est ignorée.

' 1 Chaîne de texte dans une cellule. Si la chaîne compte moins de 250 caractères,

' tous les caractères apparaissent dans le code 1 ; si la chaîne compte plus de

' 250 caractères, elle est divisée en tranches de 250 caractères. Les tranches

' sont contenues dans un ou plusieurs codes de code 3. Si des codes de code 3

' sont utilisés, le dernier groupe est un code 1 et contient moins de 250

' caractères. Cette valeur s'applique à des cellules de type texte uniquement

' et est répétée ; 1 valeur par cellule.

' 3 Chaîne de texte d'une cellule, en tranches de 250 caractères ; facultatif.

' Cette valeur s'applique à des cellules de type texte uniquement et est

' répétée ; 1 valeur par cellule.

' 340 ID de pointeur matériel de l'enregistrement de table de bloc. Cette valeur

' s'applique à des cellules de type bloc uniquement et est répétée ;

' 1 valeur par cellule.

' 144 Echelle de bloc (réel). Cette valeur s'applique à des cellules de type bloc

' uniquement et est répétée ; 1 valeur par cellule.

' 179 Nombre de définitions d'attribut dans l'enregistrement de table de bloc

' (applicable à une cellule de type bloc uniquement)

' 331 ID de pointeur logiciel de la définition d'attribut dans l'enregistrement de

' table de bloc, référencé par le code de groupe 179 (applicable à une cellule

' de type bloc uniquement). Cette valeur est répétée une fois par définition

' d'attribut.

' 300 Valeur de chaîne de texte pour une définition d'attribut, répétée une fois par

' définition d'attribut et applicable à une cellule de type bloc uniquement

' 7 Nom de style de texte (chaîne) ; remplacement appliqué au niveau de la cellule

' 140 Valeur de hauteur de texte ; remplacement appliqué au niveau de la cellule

' 170 Valeur d 'alignement de cellule ; remplacement appliqué au niveau de la cellule

' 64 Valeur de couleur du contenu de la cellule ; remplacement appliqué au niveau

' de la cellule

' 63 Valeur de couleur d'arrière-plan (remplissage) du contenu de la cellule ;

' remplacement appliqué au niveau de la cellule

' 69 Valeur Couleurs vraies pour la bordure supérieure de la cellule ;

' remplacement appliqué au niveau de la cellule

' 65 Valeur Couleurs vraies pour la bordure droite de la cellule ;

' remplacement appliqué au niveau de la cellule

' 66 Valeur Couleurs vraies pour la bordure inférieure de la cellule ;

' remplacement appliqué au niveau de la cellule

' 68 Valeur Couleurs vraies pour la bordure gauche de la cellule ;

' remplacement appliqué au niveau de la cellule

' 279 Epaisseur de ligne de la bordure supérieure de la cellule ;

' remplacement appliqué au niveau de la cellule

' 275 Epaisseur de ligne de la bordure droite de la cellule ;

' remplacement appliqué au niveau de la cellule

' 276 Epaisseur de ligne de la bordure inférieure de la cellule ;

' remplacement appliqué au niveau de la cellule

' 278 Epaisseur de ligne de la bordure gauche de la cellule ;

' remplacement appliqué au niveau de la cellule

' 283 Drapeau booléen indiquant si la couleur de remplissage est activée ;

' remplacement appliqué au niveau de la cellule

' 289 Drapeau booléen pour la visibilité de la bordure supérieure de la cellule ;

' remplacement appliqué au niveau de la cellule

' 285 Drapeau booléen pour la visibilité de la bordure droite de la cellule ;

' remplacement appliqué au niveau de la cellule

' 286 Drapeau booléen pour la visibilité de la bordure inférieure de la cellule ;

' remplacement appliqué au niveau de la cellule

' 288 Drapeau booléen pour la visibilité de la bordure gauche de la cellule ;

' remplacement appliqué au niveau de la cellule

' 70 Direction du flux ; remplacement appliqué au niveau de l'entité table

' 40 Marge de cellule horizontale ; remplacement appliqué au niveau de l'entité table

' 41 Marge de cellule verticale ; remplacement appliqué au niveau de l'entité table

' 280 Drapeau indiquant si le titre est supprimé ; remplacement appliqué au niveau de

' l'entité table

' 281 Drapeau indiquant si la rangée d'en-tête est supprimée ; remplacement appliqué

' au niveau de l'entité table

' 7 Nom de style de texte (chaîne) ; remplacement appliqué au niveau de l'entité

' table. Une entrée possible pour chaque type de cellule.

' 140 Hauteur de texte (réel) ; remplacement appliqué au niveau de l'entité table.

' Une entrée possible pour chaque type de cellule.

' 170 Alignement de cellule (entier) ; remplacement appliqué au niveau de l'entité

' table. Une entrée possible pour chaque type de cellule.

' 63 Valeur de couleur pour l'arrière-plan de la cellule ou pour la bordure

' verticale gauche de la table ; remplacement appliqué au niveau de

' l'entité table. Une entrée possible pour chaque type de cellule.

' 64 Valeur de couleur pour le contenu de la cellule ou pour la bordure

' horizontale supérieure de la table ; remplacement appliqué au niveau

' de l'entité table. Une entrée possible pour chaque type de cellule.

' 65 Valeur de couleur pour les lignes de bordure horizontale intérieure ;

' remplacement appliqué au niveau de l'entité table

' 66 Valeur de couleur pour les lignes de bordure horizontale inférieure ;

' remplacement appliqué au niveau de l'entité table

' 68 Valeur de couleur pour les lignes de bordure verticale intérieure ;

' remplacement appliqué au niveau de l'entité table

' 69 Valeur de couleur pour les lignes de bordure verticale droite ;

' remplacement appliqué au niveau de l'entité table

' 283 Drapeau indiquant si la couleur d'arrière-plan est activée (valeur par défaut = 0) ;

' remplacement appliqué au niveau de l'entité table.

' Une entrée possible pour chaque type de cellule :

' 0 = Désactivée

' 1 = Activée

'274-279 Epaisseur de ligne pour chaque type de bordure de la cellule

' (valeur par défaut = kLnWtByBlock) ;

' remplacement possible au niveau de l'entité table.

' Un groupe possible pour chaque type de cellule.

'284-289 Drapeau pour la visibilité de chaque type de bordure de la cellule

' (valeur par défaut = 1) ;

' remplacement possible au niveau de l'entité table.

' Un groupe possible pour chaque type de cellule :

' 0 = Invisible

' 1 = Visible

 

 

' Test sur les tableaux AutoCAD

Sub testtbl()

 

Dim DwgIndex As AcadTable

Dim TemplateFileName As String

Dim Entity As AcadEntity

Dim CurrentRow As Long

For Each Entity In ThisDrawing.PaperSpace

If TypeOf Entity Is AcadTable Then

Set DwgIndex = Entity

Exit For

End If

Next Entity

 

' This function updates the table block record that the Table object

' references to match changes made to the Table object since the most

' recent update of the table block record.

DwgIndex.RecomputeTableBlock False

'rows and cols are zero based

CurrentRow = 4

With DwgIndex

.HorzCellMargin = 0

.VertCellMargin = 0

.MergeCells CurrentRow, (CurrentRow + 1), 0, 2

.SetRowHeight CurrentRow, 8

.SetRowHeight CurrentRow + 1, 8

.SetCellTextHeight CurrentRow, 0, 6

.SetCellAlignment CurrentRow, 0, acMiddleCenter

.SetCellTextStyle CurrentRow, 0, "titles"

.SetText CurrentRow, 0, "HEADER"

End With

 

End Sub

'

 

Sub Example_Table()

' This example adds a table in model space

 

Dim MyModelSpace As IAcadModelSpace2

Set MyModelSpace = ThisDrawing.ModelSpace

Dim Pt(2) As Double

Dim MyTable As AcadTable

Set MyTable = MyModelSpace.AddTable(Pt, 5, 5, 10, 30)

ZoomExtents

 

End Sub

'

 

Sub Example_RegenerateTableSuppressed()

Dim MyModelSpace As IAcadModelSpace2

Dim MyTable As IAcadTable2

Dim Pt(2) As Double

Set MyModelSpace = ThisDrawing.ModelSpace

Set MyTable = MyModelSpace.AddTable(Pt, 100, 5, 5, 10)

 

'Temporarily disable the recomputing of table block

MyTable.RegenerateTableSuppressed = True

 

Dim i As Integer, J As Integer

For i = 0 To 99

For J = 0 To 4

Call MyTable.SetText(i, J, "my string " & i & ", " & J)

Next J

Next i

 

'Now force the recomputing of table block

'so that we can see the update table results

MyTable.RegenerateTableSuppressed = False

 

'You can also call RecomputeTableBlock(true) instead

'to force the regeneration of table

'MyTable.RecomputeTableBlock(True)

 

End Sub

'

 

Sub Test()

' Fields and User input into Table

Dim pickObj As AcadMText

Dim tblObj As AcadTable

Dim pickPt As Variant

Dim tblPt As Variant

With ThisDrawing.Utility

.GetEntity pickObj, pickPt, vbCrLf & "Select text: "

.GetEntity tblObj, tblPt, vbCrLf & "Select table: "

End With

 

Dim vec0(0 To 2) As Double

vec0(0) = 0#: vec0(1) = 0#: vec0(2) = 1#

Dim gotRow As Long, gotCol As Long

If tblObj.HitTest(tblPt, vec0, gotRow, gotCol) Then

tblObj.SetText gotRow, gotCol, "%<\AcObjProp Object(" & _

CStr(pickObj.ObjectID) & ").TextString \f ""%bl2"">%"

End If

End Sub

'

 

Public Sub testbloc()

 

' Sort table

Dim e As AcadEntity

Dim b As Variant 'AcadBlock

Dim eDictionary As Object

Dim sentityObj As AcadSortentsTable

 

Set eDictionary = _

ThisDrawing.ModelSpace.GetExtensionDictionary

Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")

Set b = ThisDrawing.ModelSpace

 

sentityObj.GetFullDrawOrder b, True

Dim x As Long

'For Each e In sentityObj.Block

For x = LBound(b) To UBound(b)

MsgBox b(x).ObjectName

'Next e

Next x

 

End Sub

'

 

Sub insertbloc()

 

Dim retval As Long

Dim blkObject As AcadBlock

Dim tabObject As AcadTable

Dim blkName As String

Dim blkPt As Variant

 

Set blkObject = ThisDrawing.Blocks(blkName)

retval = blkObject.ObjectID

ThisDrawing.Utility.GetEntity tabObject, blkPt, "Select Table: "

Call tabObject.SetBlockTableRecordId(4, 1, retval, True)

 

End Sub

'

 

Public Sub GetTextInTable()

 

' %<\AcExpr (297494.78935545) \f "%lu2%pr2%th44">%

 

Dim oTable As AcadTable

Dim Point As Variant

 

ThisDrawing.Utility.GetEntity oTable, Point, "Select a table"

 

With oTable

'this displays the header row,column

Debug.Print .GetText(0, 0)

End With

End Sub

'

 

Sub TestTable()

RemoveTableStyle "My Table Style"

MakeTableStyle "My Table Style"

End Sub

'

 

'

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *

'* 03 - SR Suppression style tableau utilisateur *

'* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'

Public Sub RemoveTableStyle(StyleName As String)

 

Dim oDict As AcadDictionary

Dim oTblSty As AcadTableStyle

 

'grab the tablestyle dictionary object

Set oDict = ThisDrawing.Dictionaries("Acad_TableStyle")

For Each oTblSty In oDict

'Debug.Print oTblSty.Name

Select Case oTblSty.name

Case Is = StyleName

oTblSty.Delete

End Select

Next

 

End Sub

'

 

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *

'* 04 - Création style tableau utilisateur *

'* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'

Public Sub MakeTableStyle(StyleName As String) 'future add variables to assign to this Style

 

Dim oDict As AcadDictionary

Dim aColor As New AcadAcCmColor

Dim oTblSty As AcadTableStyle

Dim sKeyName As String

Dim sClassName As String

 

'grab the tablestyle dictionary object

Set oDict = ThisDrawing.Database.Dictionaries.item("Acad_TableStyle")

sKeyName = "NewStyle"

sClassName = "AcDbTableStyle"

'create the TableStyle object in the dictionary

Set oTblSty = oDict.AddObject(sKeyName, sClassName)

With oTblSty

.name = StyleName

.Description = StyleName

.HorzCellMargin = 0.06

.VertCellMargin = 0.04

.TitleSuppressed = False

.SetTextHeight acDataRow, 4#

.SetTextHeight acHeaderRow, 5.8

.SetTextHeight acTitleRow, 6.8

.SetGridVisibility 1, 3, True ''

.SetAlignment acDataRow, acMiddleCenter

End With

 

End Sub

'

Par contre ce qui est difficile,c'est de retrouver un tableau inseré ! (s'il y a en plusieurs)

Il faut lui attacher un xdata ou bien relire le titre pour vérifier si c'est bien le bon !

Daniel OLIVES

[sechanbask]

merci beaucoup je vais sans doute regarder ça de plus près pour le nettoyeur.... merci pour ton post !

bonne soirée