sail Posté(e) le 10 février 2007 Posté(e) le 10 février 2007 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
winfield Posté(e) le 11 février 2007 Posté(e) le 11 février 2007 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.
sail Posté(e) le 12 février 2007 Auteur Posté(e) le 12 février 2007 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+
winfield Posté(e) le 12 février 2007 Posté(e) le 12 février 2007 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.
sail Posté(e) le 14 février 2007 Auteur Posté(e) le 14 février 2007 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 momenton 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 .
winfield Posté(e) le 14 février 2007 Posté(e) le 14 février 2007 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 354Les 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.
Messages recommandés
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 compteSe connecter
Vous avez déjà un compte ? Connectez-vous ici.
Connectez-vous maintenant