Résolu : AutoCAD LT 2024 - Formule dans attribut?

mickael_mansuy · ‎08-08-2023

Bonjour,

Je me posais la question s'il était possible de faire réagir des attributs d'un bloc en fonction d'un bloc proche, et non d'un autre plus éloigné?

Je m'explique, avec l'exemple en pièce jointe: l'un de nos clients nous demande des profondeurs de points relevés (3, 4 et 5), en nous basant sur des points de références pris à la surface du sol (1 et 2).

Ainsi les points 3 et 4 étant plus proche du point de référence 1, nous aurions:

Profondeur Point 3 = Z(1)-Z(3) = 255.64 - 255.26 = 0.38

Profondeur Point 4 = Z(1)-Z(4) = 255.64 - 255.25 = 0.39

Et le points 5 étant plus proche du point de référence 2, nous aurions:

Profondeur Point 5 = Z(2)-Z(5) = 255.91 - 255.26 = 0.65

Est-il possible de programmer l'attribut "Charge" pour le texte "Profondeur" (en rouge) se recalcul automatiquement en fonction de la charge de valeur "0.00" (en rouge) la plus proche?

Si les points de références 1 et 2 doivent être des blocs nommés différemment des points 3 à 5, c'est possible. Également employer un bloc que je pourrais glisser dans un calque à désactiver après (le client n'aime pas trop les éléments "non-nécessaires" aux plans ^^' .

O_Eckmann · ‎08-16-2023

Bonjour @mickael_mansuy ,

A ma connaissance et sans programmation, il n'est pas possible de faire choisir tout seul à AutoCAD, le symbole le plus proche d'un autre pour récupérer ses informations.

Maintenant qu'AutoCAD LT 2024 prend en charge le développement Lisp, il est possible d'y parvenir à l'aide d'un développement spécifique.

Olivier

Olivier Eckmann

mickael_mansuy · ‎08-16-2023

Bonjour O_Eckmann

Je vous remercie de votre aide et de vos réponses à mes différentes demandes. Je laisse le sujet ouvert que je commence tout juste à entendre parler des Lisp, je ne m'y connais pas assez pour me lancer dans l'inconnu. Peut-être que quelqu'un aura la solution ^^' .

Y.AUBRY · ‎08-17-2023

Bonjour @mickael_mansuy,

Il est possible d'utiliser la vielle commande "ATTEXTR" après avoir configurer un fichier gabarit d'extraction d'attributs.

Tu trouveras ci-joint un gabarit d'extraction "EXTRACT_HSN.txt" contenant le texte suivant :

BL:NAME C003000
BL:HANDLE C012000
BL:X N012003
BL:Y N012003
BL:Z N008002
MAT C003000
CHARGE C010000
Z=? C008002

Voir le lien de configuration du gabarit d'extraction ci-dessus pour plus de compréhension.

Du coup lors de la commande ATTEXTR :

Tu obtiendras le texte suivant :

'HSN','90922AB', 947367.112, 6747845.680, 255.64,'1','0.00','255.64'
'HSN','90922E3', 947367.439, 6747844.260, 255.26,'3','Profondeur','255.26'
'HSN','90922FF', 947368.652, 6747844.700, 255.25,'4','Profondeur','255.25'
'HSN','909231B', 947369.361, 6747844.723, 255.26,'5','Profondeur','255.26'
'HSN','90923A2', 947370.618, 6747843.986, 255.91,'2','0.00','255.91'

Avec du coup le nom du bloc, son handle, sa position en X, Y, Z, les valeurs des attributs MAT, CHARGE, Z=?

Ensuite tu peux ouvrir ce fichier dans Excel (et utiliser un séparateur sur les ",")

Dans un nouveau fichier, au niveau de l'onglet "Données" / "A partir d'un fichier texte/CSV"

Sélectionne ton fichier puis appuie sur le bouton "Charger"

Ensuite je vais te faire un code VBA pour détecter les charges

A+ Yoan

Yoan AUBRY

mickael_mansuy · ‎08-17-2023

Il y a peut-être une idée à creuser là... Je vais essayer de trouver une formule excelle pour rechercher en effet la distance mini entre les coordonnées.

Là où je bloque c'est quand tu parles de faire un ATTOUT et un HANDLE? De quoi s'agit-il?

Y.AUBRY · ‎08-17-2023

Je suis en train de te faire un bout de code sur Excel...

C'est vrai que les commandes ATTOUT et ATTIN n'existe pas dans AutoCAD LT...

Il faudra donc reprendre manuellement mais ca sera plus simple à partir d'un tableau.

A tte, je fini le code.

Yoan

Yoan AUBRY

Y.AUBRY · ‎08-17-2023

Bonjour,

Ci-joint le tableau Excel avec Macro dans le zip

Copie colle les informations issus de l'export (voir post ci-dessus) dans l'onglet "Profondeur"

Puis clique sur le bouton "LANCER CALCUL CHARGE"

Tu obtiendras le tableau suivant :

Détails du code VBA :

Module de classe "ClHSN"

Public HANDLE As String
Public X As Double
Public Y As Double
Public Z As Double
Public ATT_MAT As String
Public ATT_CHARGE As String
Public ATT_Z As String

Module de classe "ClINFO"

'Informations sur le point en cours
Public PT_AC_HANDLE As String
Public PT_AC_X As Double
Public PT_AC_Y As Double
Public PT_AC_Z As Double
Public PT_AC_MAT As String

'Informations sur le point de référence le plus proche
Public PT_REF_HANDLE As String
Public PT_REF_X As Double
Public PT_REF_Y As Double
Public PT_REF_Z As Double
Public PT_REF_MAT As String

'Valeurs calculées
Public DISTANCE As Double
Public CHARGE As Double

Code dans la partie "ThisWorkbook"

Sub PREPA()
    
    Dim Wb As Workbook
    Dim WsPr, WsPtAC As Worksheet
    Dim ListeHSN, ListePtREF, ListePtAC, ListeINFO As Collection
    Dim HSN As ClHSN
    Dim INFO As ClINFO
    Dim i, j, DL As Integer
    
    Set Wb = ActiveWorkbook 'Défintion du classeur en cours
    
    Set WsPr = Wb.Worksheets("Profondeur") 'Définition de la feuille 'Profondeur'
    Set WsPtAC = Wb.Worksheets("PT_AC") 'Définition de la feuille 'PT_AC'
        
    Set ListeHSN = New Collection 'Création d'une collection de module de classe ClHSN
    Set ListePtREF = New Collection 'Création d'une collection de module de classe ClHSN pour les points de références (CHARGE = '0.00')
    Set ListePtAC = New Collection 'Création d'une collection de module de classe ClHSN pour les points où la charge est à calculer (CHARGE = 'Profondeur')
        
    DL = WsPr.Cells(Rows.Count, 1).End(xlUp).Row 'Derniere ligne de la feuille 'Profondeur'
    
    'On parcours tous les lignes de la feuille 'Profondeur' et on les chargent dans la collection
    For i = 1 To DL
    
        Set HSN = New ClHSN 'Définition d'un nouveau module de classe ClHSN
        
        With HSN 'Chargement de la classe depuis les valeurs dans le tableau
            .HANDLE = Replace(WsPr.Range("B" & i).Value, "'", "") 'on supprime les ' lors du chargement
            .X = WsPr.Range("C" & i).Value
            .Y = WsPr.Range("D" & i).Value
            .Z = WsPr.Range("E" & i).Value
            .ATT_MAT = Replace(WsPr.Range("F" & i).Value, "'", "") 'on supprime les ' lors du chargement
            .ATT_CHARGE = Replace(WsPr.Range("G" & i).Value, "'", "") 'on supprime les ' lors du chargement
            .ATT_Z = Replace(WsPr.Range("H" & i).Value, "'", "") 'on supprime les ' lors du chargement
        End With
        
        ListeHSN.Add HSN 'Ajout de la classe dans la collection générique
        
        If HSN.ATT_CHARGE = "0.00" Then 'Si la valeur de ATT_CHARGE = '0.00' alors...
            ListePtREF.Add HSN '... on l'ajoute à la collection ListePtREF...
        Else '... sinon...
            ListePtAC.Add HSN '... on l'ajoute à la collection ListePtAC
        End If
        
    Next
    
    
    Set ListeINFO = New Collection 'Création d'une collection de module de classe ClINFO pour les points où la charge est à calculer (CHARGE = 'Profondeur')
    
    'A partir des listes on va rechercher pour chaque HSN présent dans la ListePtAC le HSN le plus proche dans la ListePtREF
    For i = 1 To ListePtAC.Count
        
        Set INFO = New ClINFO
        
        'Chargement des informations du point en cours
        With INFO
            .PT_AC_HANDLE = ListePtAC(i).HANDLE
            .PT_AC_X = ListePtAC(i).X
            .PT_AC_Y = ListePtAC(i).Y
            .PT_AC_Z = ListePtAC(i).Z
            .PT_AC_MAT = ListePtAC(i).ATT_MAT
        End With
        
        Dim X_AC, Y_AC As Double
        X_AC = ListePtAC(i).X
        Y_AC = ListePtAC(i).Y
        
        Dim DistMin, DistEC As Double
        Dim HSN_LE_PLUS_PROCHE As ClHSN
        
        DistMin = 1000000000
               
        'Recherche dans du point le plus proche dans ListePtREF
        For j = 1 To ListePtREF.Count
            Dim X_REF, Y_REF As Double
            X_REF = ListePtREF(j).X
            Y_REF = ListePtREF(j).Y
            DistEC = Math.Sqr((Math.Abs(X_REF - X_AC) ^ 2) + (Math.Abs(Y_REF - Y_AC) ^ 2))
            If DistEC < DistMin Then
                DistMin = DistEC
                Set HSN_LE_PLUS_PROCHE = ListePtREF(j)
            End If
        Next
        
         With INFO
            .PT_REF_HANDLE = HSN_LE_PLUS_PROCHE.HANDLE
            .PT_REF_X = HSN_LE_PLUS_PROCHE.X
            .PT_REF_Y = HSN_LE_PLUS_PROCHE.Y
            .PT_REF_Z = HSN_LE_PLUS_PROCHE.Z
            .PT_REF_MAT = HSN_LE_PLUS_PROCHE.ATT_MAT
            
            .DISTANCE = Round(DistMin, 2)
            .CHARGE = .PT_REF_Z - .PT_AC_Z
        End With
        
        ListeINFO.Add INFO
        
    Next
    
    'Mise à jour de l'onglet PT_AC
    
    WsPtAC.Cells.Clear 'Nettoyage
    
    'Ajout des entêtes
    WsPtAC.Range("A1").Value = "POINT DE REFERENCE"
    WsPtAC.Range("A1:E1").Merge
    
    WsPtAC.Range("A2").Value = "HANDLE"
    WsPtAC.Range("B2").Value = "X"
    WsPtAC.Range("C2").Value = "Y"
    WsPtAC.Range("D2").Value = "Z"
    WsPtAC.Range("E2").Value = "MAT"
    
    WsPtAC.Range("F1").Value = "POINT CALCULE"
    WsPtAC.Range("F1:J1").Merge
    WsPtAC.Range("F2").Value = "HANDLE"
    WsPtAC.Range("G2").Value = "X"
    WsPtAC.Range("H2").Value = "Y"
    WsPtAC.Range("I2").Value = "Z"
    WsPtAC.Range("J2").Value = "MAT"
    
    WsPtAC.Range("K1").Value = "DISTANCE"
    WsPtAC.Range("K1:K2").Merge
    
    WsPtAC.Range("L1").Value = "CHARGE"
    WsPtAC.Range("L1:L2").Merge
    
    'Ajout des valeurs
    
    Dim NbINFO As Integer
    NbINFO = ListeINFO.Count
    
    For i = 1 To NbINFO
    
        With ListeINFO(i)
            WsPtAC.Range("A" & i + 2).Value = "'" & .PT_REF_HANDLE
            WsPtAC.Range("B" & i + 2).Value = .PT_REF_X
            WsPtAC.Range("C" & i + 2).Value = .PT_REF_Y
            WsPtAC.Range("D" & i + 2).Value = .PT_REF_Z
            WsPtAC.Range("E" & i + 2).Value = .PT_REF_MAT
            
            WsPtAC.Range("F" & i + 2).Value = "'" & .PT_AC_HANDLE
            WsPtAC.Range("G" & i + 2).Value = .PT_AC_X
            WsPtAC.Range("H" & i + 2).Value = .PT_AC_Y
            WsPtAC.Range("I" & i + 2).Value = .PT_AC_Z
            WsPtAC.Range("J" & i + 2).Value = .PT_AC_MAT
            
            WsPtAC.Range("K" & i + 2).Value = .DISTANCE
            WsPtAC.Range("L" & i + 2).Value = .CHARGE
        End With
    Next
    
    'Mise en forme
    WsPtAC.Select
    
    WsPtAC.Cells.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Cells.EntireColumn.AutoFit
     
    'Ajout des couleurs
    WsPtAC.Range("A1:E2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    
    WsPtAC.Range("A3:E" & NbINFO + 2).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    WsPtAC.Range("F1:J2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    
    WsPtAC.Range("F3:J" & NbINFO + 2).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    'Ajout des bordures
    WsPtAC.Range("A1:L" & NbINFO + 2).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With

    MsgBox "Traitement terminé"
    
End Sub

A+ Yoan

Yoan AUBRY

mickael_mansuy · ‎08-17-2023

Je viens d'utiliser ton tableau. Pour le coup oui, malheureusement je devrais en effet renseigner les résultats à la main, mais au moins tous les calculs sont réalisés très rapidement ^^ .

Merci beaucoup, je valide.

Y.AUBRY · ‎08-17-2023

A tester sous LT (Je ne sais pas s'il est possible de piloter AutoCAD LT depuis Excel comme depuis une version full)

Pour pouvoir utiliser la deuxième partie du programme il faut que :

- L'onglet "PT_AC" soit compléter de la sorte :

- Le fichier AutoCAD sur lequel les attributs doivent être mis à jour soit ouvert et que l'onglet actif d'AutoCAD soit sur celui-ci.

Si le bouton "MAJ_ATT" fonctionne pas de soucis, sinon il va falloir que tu paramètres ton PC pour pouvoir utiliser la macro (ou du moins tester).

Paramétrage :

Pour cela, il va falloir utiliser l'onglet "Développeur" d'Excel.

S'il n'est pas visible, aller dans "Fichier" / "Option" (tout en bas à gauche normalement) / "Personnaliser le ruban" et cocher la case 'Développeur'

Une fois que tu as fait cela, cliquer sur le menu Développeur puis l'icone "Visual Basic"

Ensuite dans Microsoft Visual Basic pour Application, aller sur le menu "Outils" puis "Références"

Normalement tu auras cela sauf qu'il se peut fortement que tu n'ais pas la même version d'AutoCAD que celle que j'ai utilisé lors de programmation:

... donc au lieu d'avoir "AutoCAD 2021 Type Library" tu devrais avoir "MANQUANT AutoCAD 2021 Type Library" (mais je pense que c'est la même version de Framework sur la 2024 donc ca devrait être OK normalement)

Il va falloir décocher cette case, puis aller chercher dans la liste des références, celle associée à ta version d'AutoCAD

(par exemple AutoCAD LT 2024 Type Library).

Une fois que tu as fait cela tu peux cliquer sur le bouton OK, enregistrer le fichier (pour ne pas avoir a répéter cette opération à chaque ouverture du fichier bien entendu), et fermer Microsoft Visual Basic pour Applications.

Ensuite tu peux réessayer d'appuyer sur le bouton "MAJ_ATT" (si ca ne marche toujours pas c'est que ce n'est pas possible)

Détail du code ajouté :

Sub MAJ_ATT()
    
    Dim Wb As Workbook
    Dim WsPtAC As Worksheet
    
    Set Wb = ActiveWorkbook 'Défintion du classeur en cours
    Set WsPtAC = Wb.Worksheets("PT_AC") 'Définition de la feuille 'PT_AC'
    Dim ListeHSN As Collection
    Dim HSN As ClHSN
    Dim i, j, DL As Integer
    
    DL = WsPtAC.Cells(Rows.Count, 1).End(xlUp).Row 'Derniere ligne de la feuille 'Profondeur'
    
    Set ListeHSN = New Collection 'Création d'une collection de module de classe ClHSN
    
    'On parcours tous les lignes de la feuille 'Profondeur' et on les chargent dans la collection
    For i = 3 To DL
    
        Set HSN = New ClHSN 'Définition d'un nouveau module de classe ClHSN
        
        With HSN 'Chargement de la classe depuis les valeurs dans le tableau
            .HANDLE = Replace(WsPtAC.Range("F" & i).Value, "'", "") 'on supprime les ' lors du chargement
            .X = WsPtAC.Range("G" & i).Value
            .Y = WsPtAC.Range("H" & i).Value
            .Z = WsPtAC.Range("I" & i).Value
            .ATT_MAT = WsPtAC.Range("J" & i).Value
            .ATT_CHARGE = WsPtAC.Range("L" & i).Value
        End With
        
        ListeHSN.Add HSN 'Ajout de la classe dans la collection générique
       
    Next
    
    'Nécessite la référence Autocad xxx Type Library (Menu Outils > Références)
    Dim objBRef As AcadBlockReference
    
    Dim thisdrawing As AutoCAD.AcadDocument
    Set thisdrawing = AutoCAD.ActiveDocument
    
    'Parcours des entités sur l'espace objet
    For Each ent In thisdrawing.ModelSpace
    
        'Si l'entité est un bloc
        If TypeOf ent Is AcadBlockReference Then
            Set objBRef = ent
            Dim Att As Variant
            
            If objBRef.Name = "HSN" Then
                'Recherche du numéro de matricule dans le bloc
                Dim MAT, CHARGE As String
                
                CHARGE = ""
                
                For Each Att In objBRef.GetAttributes
                    Select Case Att.TagString
                        Case "MAT"
                            MAT = Att.TextString
                            Exit For
                    End Select
                Next
                
                'Recherche du HSN dans la liste
                For j = 1 To ListeHSN.Count
                    If ListeHSN(j).ATT_MAT = MAT Then
                        Set HSN = ListeHSN(j)
                        CHARGE = HSN.ATT_CHARGE
                        Exit For
                    End If
                Next
                
                If CHARGE <> "" Then 'Ne pas mettre à jour les charges des points de références
                    If IsNumeric(CHARGE) Then
                        CHARGE = Round(CHARGE, 2)
                        'Mise à jour de l'attribut
                         For Each Att In objBRef.GetAttributes
                            Select Case Att.TagString
                                Case "CHARGE"
                                    Att.TextString = CHARGE
                                    Exit For
                            End Select
                        Next
                        objBRef.Update
                    End If
                End If
                 
            End If
            
        End If
    Next
    
    MsgBox "Attributs mis à jour"
    
End Sub

Yoan AUBRY

AutoCAD LT 2024 - Formule dans attribut?

AutoCAD LT 2024 - Formule dans attribut?

Liens vers les forums

Publier dans les forums