Aller au contenu

RE-TRIER


Messages recommandés

Posté(e)

BONJOUR A TOUS

 

ETANT DONNE QUE JE N'AI PAS ETE COMPRIS JE VOUS LIVRE MON CODE QUI EST INCOMPLET . JE RECUPERE LE PT INSERTION DES BLOCS SELECTIONNES MAIS JE VOUDRAIS LES TRIER EN ORDRE CROISSANT OU DECROISSANT . EFFECTIVEMENT QUAND J'EXECUTE MA ROUTINE (msgbox)LES PTS INSERTIONS DEFILENT DU DERNIER BLOC INSERE AU PREMIER .

 

 

Dim objJeu As AcadSelectionSet

Dim Pt1, Pt2 As Variant

Dim OBJET As AcadEntity

Dim TEST As Variant

Dim x, As String

Dim BLOC As AcadBlockReference

 

Pt1 = ThisDrawing.Utility.GetPoint(, "PREMIER POINT")

Pt2 = ThisDrawing.Utility.GetCorner(Pt1, "DERNIER POINT")

Set objJeu = ThisDrawing.SelectionSets.Add("Jlqq4e")

'Selection de toutes les entites dans la fenetre

objJeu.Select acSelectionSetWindow, Pt2, Pt1

 

For Each OBJET In objJeu

If OBJET.ObjectName = "AcDbBlockReference" Then

Set BLOC = OBJET

TEST = BLOC.insertionPoint

x = TEST(0)

 

' C'EST A PARTIR DE LA QUE JE BLOQUE

 

MsgBox x

 

End If

Next

objJeu.Delete

 

 

 

MERCI POUR TOUTES VOS SULUTIONS

 

 

 

Posté(e)

Salut,

Comme sur ton 1er message, je te dirai la même chose (au niveau de l'idée).

Ci-dessous un 1er jet fait un peu à la va-vite :

Je suis parti de l'idée que ce dont tu avais besoin est d'effectuer un tri d'abord sur les X, ensuite sur les Y, SI des X sont identiques.

(en supposant que le X le plus petit est le point de départ....je n'ai pas traité le cas des Y)

 Sub TrierListeItemBloc1()

   Dim ObjSelection As AcadSelectionSet
   Dim StrNomSelection As String
   Dim objSelectionTemp As AcadSelectionSet
   Dim StrNomSelectionTemp As String
   Dim Compteur1 As Integer
   Dim Compteur2 As Integer
   Dim IntCodeDXF(0) As Integer
   Dim ValCodeDXF(0) As Variant
   Dim Index As Integer
   Dim ObjObject() As AcadEntity
   Dim i As Integer
   
   StrNomSelection = "MaSelection"
   StrNomSelectionTemp = "MaSelectionTemp"
   
   Set ObjSelection = ThisDrawing.SelectionSets(StrNomSelection)
   Set objSelectionTemp = ThisDrawing.SelectionSets(StrNomSelectionTemp)
   If Err <> 0 Then
       Err.Clear
       Set ObjSelection = ThisDrawing.SelectionSets.Add(StrNomSelection)
       Set objSelectionTemp = ThisDrawing.SelectionSets.Add(StrNomSelectionTemp)
   End If
   ObjSelection.Clear
   objSelectionTemp.Clear
   IntCodeDXF(0) = 0: ValCodeDXF(0) = "INSERT"
   ObjSelection.SelectOnScreen IntCodeDXF, ValCodeDXF
   
   ReDim ObjObject(ObjSelection.Count - 1)
   ReDim tableau(ObjSelection.Count - 1, 2)
   For i = 0 To ObjSelection.Count - 1
       Set ObjObject(i) = ObjSelection(i)
   Next
   objSelectionTemp.AddItems ObjObject
   i = -1
   While objSelectionTemp.Count > 0
       i = i + 1
       Choix = objSelectionTemp(0).Handle
       coord = objSelectionTemp(0).InsertionPoint
       For m = 0 To objSelectionTemp.Count - 1
           CoordTemp = objSelectionTemp(m).InsertionPoint
           If CoordTemp(0) < coord(0) Then
               Choix = objSelectionTemp(m).Handle
               coord = objSelectionTemp(m).InsertionPoint
           'Elseif CoordTemp(0) = coord(0)
               'Faire une boucle pour trier sur les Y
           End If
       Next
       tableau(i, 0) = Choix
       tableau(i, 1) = coord(0)
       tableau(i, 2) = coord(1)
       Dim ObjectTemp(0) As AcadEntity
       Set ObjectTemp(0) = ThisDrawing.HandleToObject(Choix)
       objSelectionTemp.RemoveItems ObjectTemp
   Wend
       MsgBox objSelectionTemp.Count
       For i = LBound(tableau) To UBound(tableau)
          liste = liste & tableau(i, 0) & "     " & tableau(i, 1) & "     " & tableau(i, 2) & "\P"
       Next
       Dim ObjMTxt As AcadMText
       PtTxt = ThisDrawing.Utility.GetPoint(, vbCr & "Point pour le texte")
       Set ObjMTxt = ThisDrawing.ModelSpace.AddMText(PtTxt, 0.1, liste)
   End Sub

 

Je m'y replongerai quand j'aurai un peu plus de temps, en espérant que ce soit bientôt !

Voilà, pour le moment, l'aide que je peux t'apporter avec mes connaissances et le temps que je peux consacrer à ce problème.

 

Nous n’ héritons pas de la terre de nos ancêtres.Nous l’empruntons à nos enfants.

Posté(e)

BONJOUR

 

TOUT D'ABORD MERCI D'AVOIR CONSACRE UN PEU DE TEMPS A MON PROBLEME .

J'AI TESTE TON CODE ET MALHEUREUSEMENT CELA NE FONCTIONNE PAS .J'AI UN MESSAGE D'ERREUR QUI M'INDIQUE "CLE INTROUVABLE" .

 

A+

Posté(e)

Oups !

Rajoute

On Error Resume Next 

devant

  Set ObjSelection = ThisDrawing.SelectionSets(StrNomSelection)
Set objSelectionTemp = ThisDrawing.SelectionSets(StrNomSelectionTemp)

Ce qui donne :

......................................
Dim i As Integer

StrNomSelection = "MaSelection"
StrNomSelectionTemp = "MaSelectionTemp"
On Error Resume Next
Set ObjSelection = ThisDrawing.SelectionSets(StrNomSelection)
Set objSelectionTemp = ThisDrawing.SelectionSets(StrNomSelectionTemp)
If Err <> 0 Then
Err.Clear
Set ObjSelection = ThisDrawing.SelectionSets.Add(StrNomSelection)
Set objSelectionTemp = ThisDrawing.SelectionSets.Add(StrNomSelectionTemp)
End If
ObjSelection.Clear
objSelectionTemp.Clear
..........................

 

Et puis entre autre chose, évite de tout écrire en majuscule, ça peut froisser quand on sait que c'est synonyme de crier. ;)

Bonne soirée

 

[Edité le 12/2/2007 par winfield]

Nous n’ héritons pas de la terre de nos ancêtres.Nous l’empruntons à nos enfants.

Posté(e)

bonjour winfield et merci de ton aide

 

j'ai testé cette routine et cela marche trés bien . j'ai juste une question .A un certain moment

on me demande de choisir les objets et j'aurais voulu savoir à quelle ligne de code cela correspond . La méthode que tu as utilisé je ne la connais pas . Je me suis inspiré du bouquin de roger rossec .

 

a+

 

 

ps : il y à peu de temps que pratique l'informatique et je ne savais pas qu'ecrire en majuscule etait un signe de mécontentement .

Posté(e)

Bonsoir sail,

Roger Rosec.........très bon livre, dommage qu'il n'y est pas une suite :(

Pour la selection, c'est :

ObjSelection.SelectOnScreen IntCodeDXF, ValCodeDXF

IntCodeDxf et ValCodeDXF étant optionnel, ça permet "d'alléger" la sélection, ce sont les filtres.

SelectionOnScreen : page 354

Les codes DXF : à partir de la page 356

;)

Hé oui, moi aussi j'apprends ; et je consulte ce livre régulièrement. Il explique vraiment bien !

Maintenant, je dirais qu'il est complémentaire du livre d'Albert Thalheim (fais une recherche sur Internet, attention les liens ne fonctionnent pas toujours correctement). Quand on débute, je dirais que ces deux livres sont ceux à avoir.

Maintenant, si quelqu'un connait un autre livre, plus poussé...je ne demande qu'à apprendre !

Bonne soirée

 

Nous n’ héritons pas de la terre de nos ancêtres.Nous l’empruntons à nos enfants.

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité