sechanbask

Acad.pgp c'est pas uniquement pour les allias? y'a pas de fichiers mnr aussi ? je me trompe peut-être et je ne peux pas vérifier car j'utilise 2006 donc c'est le CUI pour les menu, raccourci clavier, et pour allias c'est AutoCAD.pgp...

Bonjour, J'utilise des plans en XREF et à chaque fois que je lance une commande et que je passe ma souris sur un des objet de cet Xref, autocad ne répond plus pendant environ 8 minute en temps réel, il est comme gelé. Après je peux retravailler mais si je ne peux toujours pas faire mon action sur les objet de Xref. Si vous pouvez m'aider... me trouver une solution... J'ai essayé de faire un Wboc sur mes plans foireux après avoir pris tous les objets et les avoir mis sur des nouveaux fichiers que j'ai créé mais rien ne marche...ça me fait la même chose si je travaille directement sur mes plans. HELP ME P.S. il n'y a pas d'entité bizarre sur mes plans... il me semble qu'ils ont été créés en 2007 puis enregistré en 2004 [Edité le 21/7/2007 par sechanbask]

Je suis très intéressé par ton application, tu peux poster le code ? merci d'avance.

Salut, Le caption d'une userform ça ne sert qu'à mettre le titre (dans la barre bleue). Le (name) sert à nommé la userform pour qu'elle ne s'appelle plus "Userform". C'est important car si tu as dans ton projet plusieurs userform tu auras du mal à les distinguer puisqu'elles s'appelleront userform1, userform2, etc. Donc pour que le projet marche, il faut que tu mettes dans le (name) : ParaPolyligne. Pour ce qui est du caption met ce que tu veux...

tu as fait une form? Son caption c'est quoi? son (name) c'est quoi?

il faut que tu me donnes le type d'erreur car je ne l'ai pas chez moi...

désolé j'avais pas vu :-°

pour list et combobox, j'utilise ça et je pense que c'est applicable aux tableaux: 'ComboBox1.List = ListSort(ComboBox1.List) 'listBox1.List = ListSort(listBox1.List) Function ORDRECR(liSte) 'trie par ordre alphabétique croissant les données d'une list ou combo Dim First As Integer, Last As Integer Dim i As Integer, j As Integer Dim Temp First = LBound(liSte) Last = UBound(liSte) For i = First To Last - 1 For j = i + 1 To Last If liSte(i, 0) > liSte(j, 0) Then Temp = liSte(j, 0) liSte(j, 0) = liSte(i, 0) liSte(i, 0) = Temp End If Next j Next i ORDRECR = liSte End Function

redécrit-moi ton algorithme : ce que tu veux faire avec l'ordre précis... dit-moi si je me trompe: -faire apparaitre une form avec une liste avec des plusieurs choix sélectionnables, -récupérer le choix de l'utilisateur pour connaitre la taille de la polyligne à tracer et connaitre le décalage de la polyligne par rapport à un bord de poutre et faire une sortie pour informer l'utilisateur, -lancer la commande pour tracer la polyligne avec les éléments précédents. J'ai commencé un truc en suivant l'algorithme que j'ai décrit ci-dessus, s'il manque quelque chose prévient-moi car ça peut parfois changer pas mal de mécanismes. J'ai faire une userform dont le nom est : "ParaPolyligne" ne pas mettre les guillemets. je lui ai fait une combobox dont le nom est "combobox1" dans le code d'un module j'ai mis : Sub file() 'charge la userform dans la mémoire du PC Load ParaPolyligne 'décrit la combobox1 en insérant la liste de choix With ParaPolyligne.ComboBox1 .Clear 'impératif sinon à chaque fois que tu lances ton application, ça te rajoutera des item en plus .AddItem "10" .AddItem "20" .AddItem "30" .AddItem "40" End With 'provoque l'affichage de la userform ParaPolyligne.Show End Sub et dans le code de la userform, j'ai mis : Private Sub CommandButton1_Click() Dim sngElement As Single 'initialise la variable pour qu'elle reçoive le choix que l'utilisateur fait sngElement = ParaPolyligne.ComboBox1.List(ParaPolyligne.ComboBox1.ListIndex) MsgBox sngElement End Sub dit-moi si je suis bon dans le départ... après le reste suivra avec un peu d'aide de ta part pour que tu améliores ton niveau. [Edité le 9/7/2007 par sechanbask]

STP indique que ton sujet est résolu en cliquant sur l'ampoule en dessous de ton message (lorsque tu es loggé)...

Tu as un début de code pour que je te donne un coup de main, où tu n'arrive pas à débuter?

j'ai eu un peu de mal à comprendre ta blague mais j'en ai ri aux éclats !!

tu as réussi à faire tes polylignes programmables ? J'arrive à rien pour les styles de textes pour l'instant...

attendez un peu, je suis blessé et j'ai un boulot monstre pendant le prochain mois (2 collègues en vacances etc.), alors ça risque d'être long, désolé. L'idéal pour moi, ça serait de faire un ligne par bloc avec plein de colonnes pour les différents attributs pour les blocs... mais bon ça se discute. [Edité le 8/7/2007 par sechanbask]

désolé pour les fautes et abréviations mais je me suis coupé à l'intérieur de la main gauche alors je ne tape qu'avec la main droite...(promis je rendrais ça lisible pour tous quand les points de suture ne me feront plus mal) Je modifie un peu le code que tu avais fait et posté (merci pour ta contribution) pour permettre de faire des tris ou requêtes SQL. il manquait également quelques déclarations. voilà pour extraction : calc to autocad suivra si j'ai un peu de temps : Option Explicit Sub ExportAttributs_OOOo() Dim ligne As Integer Dim i As Integer Dim n As Integer Dim varAttribut As Variant Dim ObjSelection As AcadSelectionSet Dim StrSelection As String Dim chemin 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 For i = LBound(varAttribut) To UBound(varAttribut) ObjCalc.GetCellByPosition(0, ligne).SetString (ObjSelection(n).Handle) ObjCalc.GetCellByPosition(1, ligne).SetString (ObjSelection(n).Name) ObjCalc.GetCellByPosition(2, ligne).SetString (varAttribut(i).TagString) ObjCalc.GetCellByPosition(3, ligne).SetString (varAttribut(i).TextString) ligne = ligne + 1 Next i Next n If ThisDrawing.FullName <> "" Then chemin = ThisDrawing.FullName chemin = Replace(chemin, "\", "/") chemin = Replace(chemin, "dwg", "ods") DocumentoOOo.StoreAsURL "file:///" & chemin, args End If End Sub

Ça fait quelque temps que je cherchais un macro comme ça. Sauf que l'on ne peut pas considérer l'extraction comme un base de données donc c'est un peu dommage. Quand j'aurais du temps (à la retraite) j'essayerais de le faire...

je suis intrigué par ton message, j'aimerais bien savoir ce que c'est que le : AXDBLib.AxDbDocument tu pensais en faire quoi... car j'ai pas compris l'utilité en survolant (faut dire que je ne suis pas bilingue à 100%): http://www.integr-8.com/AU2003/Documents/CP13-3.PDF

dim taille as single Dim MTextObj As AcadObject dim sngInterlignegc as single dim decalage as single dim directiontexte as double dim pins as variant taille = ThisDrawing.ActiveTextStyle.LastHeight 'si on ne connait pas l'interligne If sngInterlignegc = 0 Then 'point d'insertion du Mtextobj sui sera supprimé Dim dblPinsgc(0 To 2) As Double dblPinsgc(0) = 0: dblPinsgc(1) = 0: dblPinsgc(2) = 0 'insertion du Mtextobj Set MTextObj = ThisDrawing.ModelSpace.AddMText(dblPinsgc, 25, "chaine inutile") 'on trouve la distance d'espacement sngInterlignegc = MTextObj.LineSpacingDistance With MTextObj .Update End With 'on supprime l'objet car on ne pouvait pas bien le centrer puisqu'on dois connaitre sngInterlignegc 'avant d'utiliser la méthode Set MTextObj.Delete End If 'on connait maintenant sngInterlignegc donc on peut calculer le décalage decalage = taille / 2 + sngInterlignegc / 2 'point d'insertion pins = ThisDrawing.Utility.GetPoint(, vbCrLf & "Insérer : " & texteins) directiontexte = ThisDrawing.Utility.GetOrientation(pins, vbCrLf & "Direction du texte...") 'Création du text multiligne 'Centrer en X le texte pins(0) = pins(0) - decalage * Sin(directiontexte) 'Centrer en Y le texte pins(1) = pins(1) + decalage * Cos(directiontexte) 'insertion du texte Set MTextObj = ThisDrawing.ModelSpace.AddMText(pins, largeur_du_Mtext, texteins) sngInterlignegc = MTextObj.LineSpacingDistance With MTextObj 'partie à modifier .Rotation = directiontexte .AttachmentPoint = acAttachmentPointMiddleLeft 'regen du texte uniquement .Update End With Puisque ce n'est qu'un extrait de code, il peut manque des déclarations, ou des explications, si tel est le cas, je pourrais vous aider.

Il me semble que c'est un peu coton, c'est pire que pour les types de ligne car il faut chercher les styles de texte dans des fichiers externes.. mais en informatique tout est possible, sauf que parfois le chemin est long.. Tu as un début de code pour que je te donne un coup de main, où tu n'arrive pas à débuter?

Merci beaucoup, j'ai trouvé comment le faire en VBA, c'est assez bizarre voire stupide mais bon j'ai pas trouvé mieux pour l'instant : je le posterais quand je ferai le tri dans ma procédure. Bon voilà le code : s'il manque des explications ou de déclarations de variables... demandez-moi, je serai ravi que ce code aide quelqu'un: dim taille as single dim Mtextobj as dim sngInterlignegc as single dim decalage as single dim directiontexte as double dim pins as variant taille = ThisDrawing.ActiveTextStyle.LastHeight 'si on ne connait pas l'interligne If sngInterlignegc = 0 Then 'point d'insertion du Mtextobj sui sera supprimé Dim dblPinsgc(0 To 2) As Double dblPinsgc(0) = 0: dblPinsgc(1) = 0: dblPinsgc(2) = 0 'insertion du Mtextobj Set MTextObj = ThisDrawing.ModelSpace.AddMText(dblPinsgc, 25, "chaine inutile") 'on trouve la distance d'espacement sngInterlignegc = MTextObj.LineSpacingDistance With MTextObj .Update End With 'on supprime l'objet car on ne pouvait pas bien le centrer puisqu'on dois connaitre sngInterlignegc 'avant d'utiliser la méthode Set MTextObj.Delete End If 'on connait maintenant sngInterlignegc donc on peut calculer le décalage decalage = taille / 2 + sngInterlignegc / 2 'point d'insertion pins = ThisDrawing.Utility.GetPoint(, vbCrLf & "Insérer : " & texteins) directiontexte = ThisDrawing.Utility.GetOrientation(pins, vbCrLf & "Direction du texte...") 'Création du text multiligne 'Centrer en X le texte pins(0) = pins(0) - decalage * Sin(directiontexte) 'Centrer en Y le texte pins(1) = pins(1) + decalage * Cos(directiontexte) 'insertion du texte Set MTextObj = ThisDrawing.ModelSpace.AddMText(pins, largeur_du_Mtext, texteins) sngInterlignegc = MTextObj.LineSpacingDistance With MTextObj 'partie à modifier .Rotation = directiontexte .AttachmentPoint = acAttachmentPointMiddleLeft 'regen du texte uniquement .Update End With Je vais également le poster dans les routines VBA. [Edité le 7/7/2007 par sechanbask]

La réponse de lili2006 ne te convient pas ? Tu veux vraiment faire un bouton pour une macro qui va te chercher d'autres styles de texte ?

J'ai dû mal m'exprimer: je souhaite faire une classe d'entité pour la gaine souple (ou autre chose). En gros je veux que dans la section rapide, je puisse sélectionner : gaine souple, polyligne, Ligne, textes multilignes... est-ce possible?

Bonjour, Je cherche à créer une entité supplémentaire dans autocad. Je suis actuellement en train de réaliser en VBA de la gaine souple car j'utilise fisacad et ça plante royale... J'aimerai que la gaine souple devienne selectionnable par filtre et sélection rapide. Est-ce possible?

Bonjour, Le fichier pgp gère les allias. Pour lancer une commande qui possède un allias, il faut que tu tapes sur ton clavier l'allias puis sur la barre d'espace. exemple: pour lancer une polyligne, l'allias est PO: il faut tapper P puis O puis espace. Dans le fichiers pgp (que l'on peux éditer dans - outils - personnaliser - paramètres de programme (fichier pgp) l'allias sera déclarée comme ça : PO,(tabulation)*POLYLIGN malheureusement, j'ai pas trouvé comment lancer une macro VBA avec les allias, je pense que c'est possible car j'arrive à lancer un programme externe : Firefox mais pas de VBA pour l'instant. Quelqu'un m'a même dit qu'il faisait un programme LISP pour lancer son VBA pour qu'il puisse utiliser un allias pour lancer indirectement son programme VBA... Si je trouve LA solution, promis je la posterais ici. http://www.cadxp.com/sujetXForum-15303.htm http://www.cadxp.com/sujetXForum-15191.htm [Edité le 6/7/2007 par sechanbask]

Salut, J'espère que ça pourra te servir: Dim MTextObj As AcadMText Set MTextObj = ThisDrawing.ModelSpace.AddMText(pins, largeur_du_Mtext, texteins) With MTextObj 'partie à modifier .height = taille .Rotation = directiontexte .AttachmentPoint = acAttachmentPointMiddleLeft 'regen du texte uniquement .Update End With