Surfaces,polyligne et région

ludo07 · le 14 août 2008

Bonjour à tous,

DESOLE POUR LA LONGUEUR DU MESSAGE.

Je sais que ce sujet à été de nombreuse fois traté, mais les différents programmes que j'ai pu trouver ou les différents post traitant de ce sujet ne réponde pas me semble t'il à ce que je souhaite.

Je souhaite réaliser en VBA un programme qui à partir des polylignes (représentant le contour de mes pièces) implante un bloc avec attribut au centre de mes pièces et bien entendu il faut que quand la surface change l'attribut change aussi.

Bref le lisp de Bonuscad "CurveArea-Field" fonctionne trés bien mais il implante des champs, moi je souhaite avoir des bloc avec attribut "CHAMP" afin de pouvoir extraire les données de ces blocs pour les récuperer dans excel.

Donc en parcourant le forum j'ai bien compris qu'une polyligne ne possede pas de Centroid (centre de graivité) et que pour implanter mon bloc au centre de la polyligne il faut passer par des régions.

Si je n'utilise que des régions aucun problème pour réaliser le programme VBA, mais le souci avec les régions c'est qu'elles ne sont pas modifiables.

Donc avec mon programme j'arrive à obtenir à partir des polylignes existantes des régions, je me retrouve avec des polylignes sur des régions.

Car je fais une fenêtre de selection en selectionnant 2 points, ainsi dans ma première selection j'ai mes polylignes en selection que je copie dans un bloc temporaire, j'utile ensuite grace à -sendcommande la commande REGION pour transformer les polylignes en région. En suite j'insers mon bloc provisoire en le décomposant, VOILA COMMENT J'OBTIENS DES POLYLIGNES SUR DES REGIONS.

Je coince après car mon idée est de faire un deuxième jeux de selection avec comme filtre REGION en utilisant les 2 points de ma première selection pour obtenir le centroid et ainsi obtenir le point d'insertion de mes blocs, puis après je fais un 3eme jeux de selection toujours avec les 2 mêmes points mais je filtre les polylignes pour obtenir les aires.

Bref ça ne fonctionne pas car j'ai deux boucles For.....Next indépendantes qui récupéres des données sur des entitées différentes mais mon bloc doit être inserér que sur une de ces deux boucles.

Je n'y arrive pas,

Etant passionné par le VBA et me formant seul (comme bon nombre d'entre vous je pense) quelqu'un aurait une piste, une idée..... voir même une blagounette car je viens de me prendre la tête dessus toute la journée.

A+

(gile) · le 14 août 2008

Salut,

Regarde le LISP Pline_block sur cette page, il insère un bloc (sur le centre de gravité par défaut) contenant 3 attributs : "nom de la pièce", "périmètre" et "aire" (les 2 derniers étant des champs dynamiques).

Le ZIP contient, en plus des codes, un fichier bloc exemple et un mode d'emploi pour modifier les codes.

[Edité le 14/8/2008 par (gile)]

ludo07 · le 14 août 2008

Merci (gile) je regarderais demain de la maison.

A+

Serge · le 15 août 2008

ludo07

Je ne veux pas reprendre la solution de gile qui fonctionne probablement (je n'ai pas vérifié et ce sera à lui de poursuivre au besoin). Je voulais juste ajouter un commentaire. Pour avoir développé des objets personnalisés en ObjectARX, il m'a fallut implémenter ma propre version des points d'accrochage (_endpoint, _midpoint, _center, etc.). Ce qu'il faut faire est de définir une fonction (genre réacteur) qui va recevoir l'objet sur lequel on demande le mode d'accrochage, on le décompose en ses plus petits élément de base (les primitives), on évalue le mode d'accrochage sur les primitives, on efface toutes les primitives puis on retourne le point recherché. AutoCAD fait exactement le même travail pour ses propres objets. Tout ça pour dire que la création d'objets temporaires est chose très communes et ne consomme pas de ressources apparentes. Il s'agit de le faire proprement. Ainsi, pour tes centroïdes, tu peux créer une région temporaire, lui faire les requêtes puis l'effacer après usage. Ce n'est pas honteux ni de la mauvaise programmation.

Serge

ludo07 · le 15 août 2008

Ok cool serge,

donc je suis peut être sur la bonne voie.

POur revenir au programme de (gille) que j'ai essayé c'est trés efficace, mais il permet de faire l'opération que en selectionnant les polyligne une par une, si tu pouvais rajouter une fenêtre de capture et que le programme traite toutes les polylignes en une seule fois se serait énorme.

Mais dans ce cas précis il faudrait que le nom de la pièce soit PIECE? et que le nom s'incrémente PIECE01, PIECE02........

A+

Serge · le 15 août 2008

ludo07

Dans ton message initial, tu disais vouloir un programme en VBA et maintenant tu veux une routine qui sélectionne en AutoLISP (faute de grives on mange des merles). Quoi qu'il en soit, j'ai fait une petite routine en VBA (Note: à partir de lundi, j'aurai moins de temps)

Prérequis:

Avoir déjà créé un bloc nommé "PROPERTIES" dans lequel les attributs suivants existent: AREA, PERIMETER, CENTROID0 et CENTROID1. À défaut, voir la routine WriteProperties ci-après

Excécution:

On passe par la fonction Main (ou Toto dans la fenêtre d'exécution)

Attention:

L'éditeur de cette page modifie les codes [surligneur] <(or), (or)>, <(and) et (and)> [/surligneur]en pensant qu'il s'agit de balises HTML. Dans le code en jaune ci-après, j'ai intercalé une espace avant le > ou après le < selon le cas pour déjouer l'éditeur. Il faut les supprimer dans le vrai code(c'est ce qui explique les très nombreux essais et erreurs que j'ai du faire avant que l'appararence du code soit le plus fidèle possible).

' Écriture des propriétés d'objets fermés dans des blocs.
' Par Serge Camiré, 2008-08-15

Option Explicit
Const PI As Double = 3.14159265358979

Type RegionProperties
  Perimeter As Double
  Area As Double
  Centroid(1) As Double               ' Point 2D
  MomentOfInertia(1) As Double        ' Point 2D
  RadiiOfGyration(1) As Double        ' Point 2D
  ProductOfInertia As Double          ' Puisque la région est 2D
  PrincipalDirections(2) As Double    ' Point 3D
  PrincipalMoments(1) As Double       ' Point 2D
End Type

Private Sub main()
  On Error GoTo Hell
  Dim Success As Boolean
  Dim ClosedObjects() As AcadEntity
  Dim Mode As AcSelect: Mode = acSelectionSetCrossing
  Success = GetClosedObjects(ClosedObjects, ByVal Mode)
  
  Dim RegProperties() As RegionProperties
  Dim Perimeter As Double
  Dim Area As Double
  Dim Centroid As Variant
  If Success Then Success = GetProperties(ClosedObjects, RegProperties())
  If Success Then Success = WriteProperties(RegProperties())
  Exit Sub
  
Hell:
  Debug.Print "Erreur[" & Err.Number & "] : "; Err.Description
  Err.Clear
  
End Sub

Private Function WriteProperties(RegProperties() As RegionProperties) As Boolean
  ' Écrire les propriétés (aire, périmètre, centroid) d'une collection d'objets fermés préalablement analysée
  ' RegProperties: tableau des propriétés. Pour ajouter des propriétés, modifier le Type
  
  ' ATTENTION: Un bloc nommé "PROPERTIES" doit déjà exister dans le dessin et comporter les bons attributs
  ' Dans l'exemple, on a supposé les 4 attributs suivants: AREA, PERIMETER, CENTROID0 et CENTROID1
  ' Idéalement, on devrait créer un calque spécifique pour ces blocs. Le calque serait vidé avant de ré-insérer les blocs
  
  On Error GoTo Hell
  WriteProperties = False
  Dim i As Integer
  Dim j As Integer
  Dim blockRefObj As AcadBlockReference
  Dim varAttributes As Variant
  Dim insertionPoint(0 To 2) As Double
  Dim unit As Long: unit = acDecimal
  Dim precision As Integer: precision = 3
  
  For i = LBound(RegProperties) To UBound(RegProperties)
     Debug.Print "Area: " & RegProperties(i).Area, "  Perimètre: " & RegProperties(i).Perimeter, _
        "Centroide: " & RegProperties(i).Centroid(0); "," & RegProperties(i).Centroid(1)
        
     ' Insert the block
     insertionPoint(0) = RegProperties(i).Centroid(0): insertionPoint(1) = RegProperties(i).Centroid(1): insertionPoint(2) = 0
     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPoint, "PROPERTIES", 1#, 1#, 1#, 0)
     
     ' Modify attributes
     varAttributes = blockRefObj.GetAttributes
     For j = LBound(varAttributes) To UBound(varAttributes)
        Select Case varAttributes(j).TagString
        Case "AREA"      ' Le tag d'un de nos attributs
           varAttributes(j).TextString = ThisDrawing.Utility.RealToString(RegProperties(i).Area, unit, precision)
           
        Case "PERIMETER" ' Le tag d'un de nos attributs
           varAttributes(j).TextString = ThisDrawing.Utility.RealToString(RegProperties(i).Perimeter, unit, precision)
        
        Case "CENTROID0" ' Le tag d'un de nos attributs
           varAttributes(j).TextString = ThisDrawing.Utility.RealToString(RegProperties(i).Centroid(0), unit, precision)
        
        Case "CENTROID1" ' Le tag d'un de nos attributs
           varAttributes(j).TextString = ThisDrawing.Utility.RealToString(RegProperties(i).Centroid(1), unit, precision)
        End Select
     Next j
     blockRefObj.Update
  Next i
  
  WriteProperties = True
  Exit Function
  
Hell:
  Debug.Print "Erreur[" & Err.Number & "] : "; Err.Description
  Err.Clear
  WriteProperties = False

End Function

Private Function GetProperties(ClosedObjects() As AcadEntity, ByRef RegProperties() As RegionProperties) As Boolean
  ' Obtenir les propriétés (aire, périmètre, centroid) d'une collection d'objets fermés (efface les régions temporairement créées)
  ' ClosedObjects : /* IN */ Objets fermés
  ' RegProperties: tableau des propriétés. Pour ajouter des propriétés, modifier le Type
  
  On Error GoTo Hell
  GetProperties = False
  
  Dim regionObjects As Variant
  Dim regionObject As AcadRegion
  Dim Success As Boolean
  Dim i As Integer
  
  ' La méthode VBA AddRegion ignore la variable DELOBJ. Les objets originaux sont toujours préservés
  regionObjects = ThisDrawing.ModelSpace.AddRegion(ClosedObjects)
  ReDim RegProperties(UBound(regionObjects))
  
  Success = True
  For i = LBound(regionObjects) To UBound(regionObjects)
     Set regionObject = regionObjects(i)
     Success = Success And GetRegionProperties(regionObject, RegProperties(i))
     regionObject.Delete  ' Effacer la région temporaire
  Next i
  
  GetProperties = Success
  Exit Function
  
Hell:
  Debug.Print "Erreur[" & Err.Number & "] : "; Err.Description
  Err.Clear
  GetProperties = False
  
End Function

Private Function GetRegionProperties(regionObject As AcadRegion, ByRef RegProperties As RegionProperties) As Boolean
  ' Obtenir les propriétés (aire, périmètre, centroid, etc.) d'une région (n'efface pas les objets)
  ' regionObject : /* IN */ Region
  ' RegProperties: tableau des propriétés. Pour ajouter des propriétés, modifier le Type
  
  On Error GoTo Hell
  GetRegionProperties = False
  
  RegProperties.Perimeter = regionObject.Perimeter
  RegProperties.Area = regionObject.Area
  
  RegProperties.Centroid(0) = regionObject.Centroid(0)
  RegProperties.Centroid(1) = regionObject.Centroid(1)
  
  RegProperties.MomentOfInertia(0) = regionObject.MomentOfInertia(0)
  RegProperties.MomentOfInertia(1) = regionObject.MomentOfInertia(1)
  
  RegProperties.RadiiOfGyration(0) = regionObject.RadiiOfGyration(0)
  RegProperties.RadiiOfGyration(1) = regionObject.RadiiOfGyration(1)
  
  RegProperties.ProductOfInertia = regionObject.ProductOfInertia
  
  RegProperties.PrincipalDirections(0) = regionObject.PrincipalDirections(0)
  RegProperties.PrincipalDirections(1) = regionObject.PrincipalDirections(1)
  RegProperties.PrincipalDirections(2) = regionObject.PrincipalDirections(2)
  
  RegProperties.PrincipalMoments(0) = regionObject.PrincipalMoments(0)
  RegProperties.PrincipalMoments(1) = regionObject.PrincipalMoments(1)
  
  GetRegionProperties = True
  Exit Function
  
Hell:
  Debug.Print "Erreur[" & Err.Number & "] : "; Err.Description
  Err.Clear
  GetRegionProperties = False

End Function

Private Function GetClosedObjects(ByRef ClosedObjects() As AcadEntity, ByVal Mode As Integer) As Boolean
  ' Sélection d'objets fermés.
  ' ClosedObjects : /* Out */ collection d'objets trouvés
  ' Mode : /* In */ acSelectionSetWindow, acSelectionSetCrossing,acSelectionSetAll,
  '                 acSelectionSetPrevious ,acSelectionSetLast
  '                 ou encore 1000 pour SelectOnScreen
  '                 À faire: acSelectionSetFence, acSelectionSetWindowPolygon, acSelectionSetCrossingPolygon
  ' Valeur de retour: True si la collection contient des objets validés.

  On Error GoTo Hell
  GetClosedObjects = False
  
  Dim i As Integer
  Dim sset As AcadSelectionSet
  
  Dim FilterType() As Integer
  Dim FilterData() As Variant
  Dim Codes As Variant
  Dim Datas As Variant
  Codes = Array( _
     -4, _
        -4, 0, 70, -4, _
        -4, 0, 70, -4, _
        -4, 0, 41, 42, -4, _
        0, _
        0, _
     -4)
  Datas = Array( _
 [surligneur]      "< or", _
        "< and", "POLYLINE", 1, "and >", _
        "< and", "LWPOLYLINE", 1, "and >", _
        "< and", "ELLIPSE", 0, 2 * PI, "and >", _
        "SPLINE", _
        "CIRCLE", _
     "or >")[/surligneur]
  ReDim FilterType(UBound(Codes))
  ReDim FilterData(UBound(Codes))
  For i = LBound(Codes) To UBound(Codes)
     FilterType(i) = Codes(i)
     FilterData(i) = Datas(i)
  Next i
   
  Dim Pt1(0 To 2) As Double
  Dim Pt2(0 To 2) As Double
  Dim returnPnt As Variant
  
  Set sset = ThisDrawing.SelectionSets.Add("ClosedObjects")
  Dim Message As String: Message = vbCrLf & "Sélection d'objets fermés" & vbCrLf
  Select Case Mode
  Case acSelectionSetWindow, acSelectionSetCrossing
     ThisDrawing.Utility.Prompt Message
     returnPnt = ThisDrawing.Utility.GetPoint(, "Premier coin: ")
     Pt1(0) = returnPnt(0): Pt1(1) = returnPnt(1): Pt1(2) = returnPnt(2)
     returnPnt = ThisDrawing.Utility.GetCorner(Pt1, "Coin opposé: ")
     Pt2(0) = returnPnt(0): Pt2(1) = returnPnt(1): Pt2(2) = returnPnt(2)
     sset.Select acSelectionSetWindow, Pt1, Pt2, FilterType, FilterData
     
  Case acSelectionSetAll, acSelectionSetPrevious, acSelectionSetLast
     sset.Select acSelectionSetWindow, FilterType, FilterData
     
  Case 1000   ' SelectOnScreen
     ThisDrawing.Utility.Prompt Message
     sset.SelectOnScreen FilterType, FilterData
     
  Case Else
     MsgBox "Mauvais mode passé en paramètre", vbCritical + vbDefaultButton1 + vbOKOnly, "GetClosedObjects"
     GetClosedObjects = False
     Exit Function
  End Select
  
  Dim Found As Boolean
  Dim SelectedObject As AcadEntity
  Dim SplineObject As AcadSpline
  Dim Count As Integer
  Dim IsClosed As Boolean
  Found = False
  Count = 0
  If sset.Count > 0 Then
     For i = 0 To sset.Count - 1
        Set SelectedObject = sset(i)
        
        ' Le cas du Spline est trop complexe pour le gérer via des filtres.
        Select Case SelectedObject.ObjectName
        Case "AcDbSpline"
           Set SplineObject = SelectedObject
           If SplineObject.Closed = True Then IsClosed = True
        Case Else
           IsClosed = True
        End Select
        
        If IsClosed Then
           ReDim Preserve ClosedObjects(Count)
           Count = Count + 1
           Set ClosedObjects(i) = sset(i)
           Found = True
        End If
     Next i
  End If
  
  ThisDrawing.SelectionSets("ClosedObjects").Delete  ' Détruit la collection
  Set sset = Nothing
  GetClosedObjects = True
  Exit Function
  
Hell:
  Dim SS As AcadSelectionSet
  If Err.Number = -2145320851 Then
     ThisDrawing.SelectionSets("ClosedObjects").Delete  ' Détruit la collection
     Set sset = Nothing
     Resume Next
  End If
  
  Debug.Print "Erreur[" & Err.Number & "] : "; Err.Description
  If ThisDrawing.SelectionSets.Count > 0 Then
     For Each SS In ThisDrawing.SelectionSets
        If SS.Name = "ClosedObjects" Then
           ThisDrawing.SelectionSets("ClosedObjects").Delete  ' Détruit la collection
           Set sset = Nothing
        End If
     Next SS
  End If
  GetClosedObjects = False
  Err.Clear
  Exit Function

End Function

Public Sub toto()
  main
End Sub

Serge[Edité le 15/8/2008 par Serge][Edité le 15/8/2008 par Serge][Edité le 15/8/2008 par Serge][Edité le 15/8/2008 par Serge][Edité le 15/8/2008 par Serge]

[Edité le 15/8/2008 par Serge]

ludo07 · le 16 août 2008

Salut Serge,

Non je souhaite bien réaliser un programme en VBA. Mais je me devez de répondre à (gilles) car il m'a aiguillé sur un programme lisp. Et il est vrais que je lui faisait une suggestion d'amélioration.

J'assai tout de suite ton programme.

A tout

ludo07 · le 16 août 2008

Serge, j'ai copié ton code, et je l'ai collé dans un fichier VBA vierge.

Voilà ce qui se passe quand je voeux l'utiliser.

Je pense que j'ai des lacunes.

http://cjoint.com/?iqpGHub8tY

Si tu peux m'aider.

A+

Serge · le 17 août 2008

ludo07

VBA répartit 4 dossiers dans un projet selon le type de code

1) AutoCAD Objets : on s'en sert beaucoup pour les réacteurs, ce qui n'est pas notre besoin. Il existe d'autres équivalent selon le logiciel utilisé. L'équivalent dans Excel est ""Microsoft Excel Objects"

2) Feuilles (Sheets) : ce sont les boites de dialogue

3) Modules: pour y placer les déclarations, les fonctions et les sous-routines. C'est l'endroit où placer le code. On y reviendra.

4) Modules de classe: pour définir des classes avec leurs méthodes et propriétés (dans les limites du VBA)

Le dossier 1 existe par défaut. Pour les 3 autres, on va dans le menu Insertion puis on choisit le type de dossier. Dans notre cas, c'est Insertion -> Module. À gauche, dans l'arborescence de ton projet, tu devrais maintenant voir un dossier "Modules" avec un enfant nommée "Module1". Tu fais un double-clic dessus pour l'activer puis tu y colles le code.

Serge

ludo07 · le 17 août 2008

Bonjour à tous,

Merci serge, j'aurais pu y penser tous seul, il est vrais que mon premier reflexe à étais de copier le code dans Thisdrawing et pas dans un module.

Je dois continuer à progresser.

En tous cas ça fonctionne je vais en profiter pour étudier ton code pour apprendre.

Merci à toi.

Je pense que tu m'en voudra pas mais j'ai déjà prévu de completre ton code en y ajoutant la vérification et la création du bloc.

Merci à toi et je vais en profiter pour laisser un message perso: JE SUIS EN VACANCE POUR 2 SEMAINES ET JE PART EN VOYAGE.

A+

Serge · le 19 août 2008

ludo07,

Mon but est de donner les directions pour que les gens deviennent autonomes, donc c'est très bien vu d'améliorer le programme. La seule chose que je demande, si j'ai inscrit mon nom quelque part, il devrait rester visible.

Bonne vacances, les miennes viennent de se terminer (même si je viens de me taper aujourd'hui mon 3e demi-marathons en 5 jours pour me tester dimanche prochain).

Serge

ludo07 · le 15 octobre 2008

Bonjour à tous,

Dans le programme ci-dessus fait par Serge, je souhaiterais que la valeur de l'attribut AREA soit un attribut dans lequel il y a un champs/

Afin de pouvoir toujours exporter les données et surtous pour que une fois inserer cette valeur suive les modifications de la polyligne de surface.

A+

Connexion

Surfaces,polyligne et région

Messages recommandés

ludo07

(gile)

ludo07

Serge

ludo07

Serge

ludo07

ludo07

Serge

ludo07

Serge

ludo07

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante