winfield

Puis ...........SecondLife Quel en est le vraiment le sens ? Alllon-nous devenir orphelins ?

Que le sujet est vieux !!! Les reactors avec le Lisp, perso, je n'ai pas eu encore la chance de le voir...suis peut-être pas encore assez vieux, ou trop :o . Réactors VLisp, j'ai vu, réactors vba, pas vraiment, vu que le vba fonctionne différemment, mais ce que font les réactors, du moins le résultat, le vba sait le faire aussi et n'a pas attendu "l'invention" du vlisp. ...........ni des gens qui vivent dans l'ombre des autres. Quand à ma citation, si certains sont trop "lourding" pour ne pas comprendre que ce n'est que de l'humour,malgré que ce ne soit pas pas en italique : je les plains. A bon surfer, bonne soirée et bon surf !

Je me sens de bonne humeur ce soir, donc, ma réponse va être aussi rapide que tu le désires, mais malheureusement, risque d'être soporiphique. En haut à gauche, il y a un truc muche où c'est marqué "recherche" Zut, Maximilien m'a devancé, moi qui me disais que ma réponse allait encore faire couler beaucoup d'encre ;) [Edité le 22/2/2007 par winfield]

Bein avec du VBA.... j'ai rien compris ou quoi :casstet:

Je suis vraiment désolé, j'avais pas vu ta réponse. Sub ZoomBloc() Dim ObjSelection As AcadSelectionSet Dim StrNomSelection As String StrNomSelection = "MaSelection" On Error Resume Next Set ObjSelection = ThisDrawing.SelectionSets(StrNomSelection) If Err <> 0 Then Err.Clear Set ObjSelection = ThisDrawing.SelectionSets.Add(StrNomSelection) End If ObjSelection.Clear Dim DataCodeDxf(0) As Variant Dim CodeDxf(0) As Integer CodeDxf(0) = 0: DataCodeDxf(0) = "INSERT" ObjSelection.SelectOnScreen CodeDxf, DataCodeDxf If ObjSelection.Count = 0 Then ObjSelection.Delete Exit Sub End If Dim Pt1 As Variant Dim Pt2 As Variant 'ci-dessous, je crois que je fais un truc pas très catholique mais 'bon, ça reconnait lorsque tu appuyes sur la touche entrée pour 'passer au bloc suivant For i = 0 To ObjSelection.Count - 1 ObjSelection(i).GetBoundingBox Pt1, Pt2 ZoomWindow Pt1, Pt2 msg = ThisDrawing.Utility.GetKeyword(vbCr & "Bloc n°" & i & " Entrée :") If Err <> 0 Then Err.Clear Exit Sub End If Next End Sub A modifier selon tes besoins Bonne continuation

Je me sens l'âme d'un irréductible.....mes profs me le disaient déjà. :cool:

Quelle question ! :exclam: Quand je serai à la retraite............j'aurais plus de temps :P (ça, c'est à voir :( )

Bonsoir, Lors de mes recherches sur les dbx, je suis tombé sur ça, en espérant que ça puisse vous aider, car, perso, je connais pas les parenthèses et encore moins le russe :P . (defun C:TEST ( / from File obj ) (vl-load-com) (setq from "D:\\test.dwg") (setq File (vla-open (vla-get-documents(vlax-get-acad-object)) from)) ;;;Делать все надо vla методами (princ "\nИмя файла-")(princ (vlax-variant-value (vla-GetVariable File "DWGNAME"))) (princ "\nТекущий слой-")(princ (vlax-variant-value (vla-GetVariable File "CLAYER"))) (princ "\nКол-во объектов в модели-")(princ (vla-get-Count (vla-get-ModelSpace File))) (princ "\nРисуем линию от 0,0 до 100,100") (setq obj (vla-AddLine (vla-get-ModelSpace file) (vlax-3d-point '(0 0 0))(vlax-3d-point '(100 100 0)))) (vla-put-color obj acRed) [surligneur] (vla-saveas File from ac2004_dwg) [/surligneur] ;(vla-put-ActiveDocument (vlax-get-acad-object) File) ;_Можно сделать активным (vla-close File) (vlax-release-object File) (princ) ) http:// http://www.autocad.ru/cgi-bin/f1/board.cgi?t=30550fh Bonne continuation à moins de faire comme en vb : DBX.SaveAs (StrChemin) Ce qui revient à dire qu'il faut redonner le chemin même s'il le connait déjà. ...........je crois que j'ai assez dit de bêtises. [Edité le 21/2/2007 par winfield]

:casstet: :casstet: :casstet: :casstet: :casstet: :casstet: :casstet: Allez ! J'ose ou j'ose pas ? :casstet: Hummmm, NAN ! Pensons à la sérénité du forum. ..............je ne savais même pas que la terre était un cube ! Comme quoi on en apprend vraiment tous les jours. Bonne soirée [Edité le 20/2/2007 par winfield]

Bonsoir, un petit tour à cette adresse : http:// http://www.cadmin.com/VBA_for_ADT/ObjectDBX.htm

Bonjour, Je suis tombé sur un vieux sujet, qui m'a interpellé : http:// http://discussion1.autodesk.com/thread.jspa?threadID=274514 Je ne veux pas prendre parti, je voudrais simplement savoir : qu'est-ce qui fait qu'une information est superficielle ou pas. Le sujet date de 2002, mais quelle évolution ! Le boulanger de mon quartier "slice" le pain si on le désire et pour pas un penny de plus :D

Bonjour, Comment supprimer un layout en passant par ObjectDBX ? Je fais une boucle sur les présentations, il trouve celle que je veux, je demande de la supprimer et là, il me balance que la présentation n'existe pas ! Même chose si je veux renommer le layout. Merci d'avance. Désolé je me suis trompé de forum. Si Patrick pouvait déplacer ce sujet en VBA...Merci, et encore toutes mes excuses. [Edité le 18/2/2007 par winfield]

Bonjour, Ces plantages me sont arrivés également. Sur le coup, je n'ai pas trop cherché à comprendre car je n'avais pas le temp, mais il m'a semblé que c'était dû à UNE entité. (Un reste de reactors persistant ? ou des trucs peut-être en rapport avec AcadProxy ?)

Bonsoir, Même après un regen ? Si c'est le cas, c'est vraiment bizarre que le décalage soit de 4 décimales :o Celà m'arrive parfois (simplement au niveau du visuel, un chouya de décalage) mais si je mesure la distance, elle est égale à zéro ! Sinon, il ne me reste plus que 2 options, soit l'avis de Jalna, soit un bug, mais bon, je n'ai plus 2006 depuis un bon moment alors............... Parfois au crois cliquer au bon endroit..........et des fois il y a trops d'accrobj activé [Edité le 16/2/2007 par winfield]

Bonsoir, trêve de cou.....des. Qqn a-t-il déjà testé AXDBLib.AxDbDocument ? J'ai trouvé très peu d'infos et comme de bien entendu : only in english :( . et apparemment, pas vraiment de succès. Si vous avez des infos....

Bonsoir sail, Roger Rosec.........très bon livre, dommage qu'il n'y est pas une suite :( Pour la selection, c'est : 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

Je l'ai déjà dit, le code de Maxence fonctionne très bien. Il te faut juste charger la bonne bibliothèque. Le sujet a d'ailleur été traité sur ce post http:// http://www.cadxp.com/sujetXForum-11717.htm Bonne journée

CADXP est un forum CAO et DAO #[0-9]+# FAUX Je ne suis pas sûr de comprendre : reconnaitre des mots ou des nombres pour en faire une liste, c'est déjà difficile dans certains cas. Mais là, on peut aussi faire reconnaitre un chiffre (nombre ?) écrit en lettre comme étant un nombre, et sans taper des Kms de codes ?

Je vous remercie d'avoir testé et je suis content que ça vous plaise Prochaine étape, Base ? :casstet:

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]

Bonsoir, T'es sûr de vouloir passer par SendCommand ?

Bonsoir, C'est pour faire suite au sujet ci-après http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=4707#pid54382 Voici une petite contribution à mon niveau. Bien sûr, c'est pour ceux qui n'ont pas/ne veulent pas du pack Office. Cette routine extrait les attributs des blocs dans Calc (tableur d'OpenOffice) 1ere colonne =n° Handle 2ème colonne = Nom du bloc 3ème colonne=Etiquette d'attribut 4ème colonne=Valeur d'attributs ( même si le bloc a plusieurs attributs) (c'est mieux quand le fichier dwg est enregistré, comme ça, le fichier Calc peut être enregistré automatiquement) Sub ExportAttributs_OOOo() Dim ObjSelection As AcadSelectionSet Dim StrSelection As String StrSelection = "MaSelection" On Error Resume Next Set ObjSelection = ThisDrawing.SelectionSets(StrSelection) If Err <> 0 Then Err.Clear Set ObjSelection = ThisDrawing.SelectionSets.Add(StrSelection) End If ObjSelection.Clear Dim DataCodeDxf(1) As Variant Dim CodeDxf(1) As Integer CodeDxf(0) = 0: DataCodeDxf(0) = "INSERT" CodeDxf(1) = 66: DataCodeDxf(1) = 1 ObjSelection.Select acSelectionSetAll, , , CodeDxf, DataCodeDxf If ObjSelection.Count = 0 Then ObjSelection.Delete MsgBox "Il n'y a pas de blocs avec attributs dans ce dessin", vbInformation, "Abandon" Exit Sub End If Dim serviceManager As Object Dim Desktop As Object, DocumentoOOo As Object Dim args() Dim ObjCalc As Object Set serviceManager = CreateObject("com.sun.star.serviceManager") Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop") Set DocumentoOOo = Desktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, args) Set ObjCalc = DocumentoOOo.Sheets().getByIndex(0) ObjCalc.GetCellByPosition(0, 0).SetString ("Hand") ObjCalc.GetCellByPosition(1, 0).SetString ("Nom bloc") ObjCalc.GetCellByPosition(2, 0).SetString ("Etiquette") ObjCalc.GetCellByPosition(3, 0).SetString ("Valeur") Ligne = 1 For n = 0 To ObjSelection.Count - 1 Ligne = Ligne + 1 VarAttribut = ObjSelection(n).GetAttributes ObjCalc.GetCellByPosition(0, Ligne).SetString (ObjSelection(n).Handle) ObjCalc.GetCellByPosition(1, Ligne).SetString (ObjSelection(n).Name) For i = LBound(VarAttribut) To UBound(VarAttribut) ObjCalc.GetCellByPosition(2, Ligne).SetString (VarAttribut(i).TagString) ObjCalc.GetCellByPosition(3, Ligne).SetString (VarAttribut(i).TextString) Ligne = Ligne + 1 Next Next If ThisDrawing.FullName <> "" Then Chemin = ThisDrawing.FullName Chemin = Replace(Chemin, "\", "/") Chemin = Replace(Chemin, "dwg", "ods") DocumentoOOo.StoreAsURL "file:///" & Chemin, args End If End Sub Et comme il faut un retour :cool: (Calc=>Acad) Sub ImportAttributs_OOOo() Dim serviceManager As Object Dim Desktop As Object, DocumentoOOo As Object Dim ObjCalc As Object Dim Chemin As String Dim AffichageoOOo(0) If ThisDrawing.FullName <> "" Then Chemin = "file:///" & ThisDrawing.FullName Chemin = Replace(Chemin, "\", "/") Chemin = Replace(Chemin, "dwg", "ods") Else MsgBox "Il n'y a pas de fichier Calc pour ce dessin." & Chr(13) _ & "Le nom du fichier Calc doit avoir le même nom que le fichier dwg" & Chr(13) _ & "et doit se trouver dans le même répertoire.", vbInformation, "Fichier Calc manquant" Exit Sub End If Set serviceManager = CreateObject("com.sun.star.serviceManager") Set Desktop = serviceManager.createInstance("com.sun.star.frame.Desktop") Set AffichageoOOo(0) = serviceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue") AffichageoOOo(0).Name = "Hidden" AffichageoOOo(0).Value = True Set DocumentoOOo = Desktop.loadComponentFromURL(Chemin, "_blank", 0, AffichageoOOo()) Set ObjCalc = DocumentoOOo.Sheets().getByIndex(0) NumLigne = 2 fin = False Do hand = ObjCalc.GetCellByPosition(0, NumLigne).String Set ObjectTemp = ThisDrawing.HandleToObject(hand) VarAttribut = ObjectTemp.GetAttributes While ObjCalc.GetCellByPosition(2, NumLigne).String <> "" For n = LBound(VarAttribut) To UBound(VarAttribut) If ObjCalc.GetCellByPosition(2, NumLigne).String = VarAttribut(n).TagString Then VarAttribut(n).TextString = ObjCalc.GetCellByPosition(3, NumLigne).String VarAttribut(n).Update End If Next NumLigne = NumLigne + 1 Wend NumLigne = NumLigne + 1 If ObjCalc.GetCellByPosition(2, NumLigne).String = "" And ObjCalc.GetCellByPosition(2, NumLigne + 1).String = "" Then fin = True End If Loop While fin = False DocumentoOOo.dispose End Sub Voilà ! J'espère que ça pourra aider certains d'entre vous.

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.

Bonjour, Est-ce la bonne méthode ? Je ne pense pas qu'il y est de bonnes ou mauvaises méthodes pour ce genre de chose, c'est aux goûts de chacun. Voici plus ou moins comment je procède : Si je n'ai pas le symbole voulu, je le dessine (même dans mon fichier en cour). Généralement, je mets toutes les entités dans le calque 0 couleur=dubloc (sauf dans certains cas) Type ligne=dubloc (sauf dans certains cas) Epaisseur=dubloc (sauf dans certains cas) Je mets des attributs si nécessaire j'exporte avec WBLOC, bien sûr sans oublier d'indiquer le point d'insertion. Dans mon fichier de travail, j'insère le bloc. Une fois inséré, j'en insère ou je copie le bloc autant de fois que j'en ai besoin. Faire un copié/collé du symbole depuis le fichier source ne fait pas de ce dernier un bloc, à moins de le "coller en tant que bloc". Si tu as X blocs nommé "Interrupteur01". Tu modifies ton fichier source (le rond blanc passe en rond rouge par ex) et que tu ré-insères le bloc MAIS en repointant sur le fichier source, là, tous tes blocs Interrupteur01 deviendront rouge. Tu peux également modifié la définition du bloc dans ton fichier de travail avec RefEdit et finir avec CloreRef. Comme ça tu ne modifie pas le fichier source, il faut voir en fonction de tes besoins. J'espère t'avoir aidé.

Et bé, moi qui pensait faire des heureux :o Personne d'autre qui s'interresse aux liaisons AutoCAD-oOOo ?