nazemrap

Bonsoir, je ne sais pas si cela va t' arrager; voici le contenu d'un fichier forme (shp) il sera donc à compiler (shx) *230,10,TUBCAR 014,010,01C,018,022,002,02A,001,01A,0 il génére une barre oblique assez grande, à modifier donc éventuellement.

Hello Didier moi aussi j 'ai commencé avec Excel ! dans le temps....moi aussi. Mais Puissance 4, je souhaite voir.

Non, mais je sais bien que si personne ne s' y met, ça va me démanger. Comme je dois aussi faire d' autres choses. Alors je sollicite ! En fait, je crois que j 'aime bien ça. D 'autre part, même si je ne demande pas toujours, j 'ai pioché beaucoud d 'éléments ici. Si je peux renvoyer l 'ascenceur, même petitement, j'en suis enchanté.

Re, En voilà une idée quelle est bonne! Ce serait super.

Bonjour et bonnes fêtes à tous, J 'ai changé de rubrique, celle-ci me paraissant plus adaptée. J 'ai voulu terminer mon challenge, cela n'a pas été sans mal. Je le soumets donc à vos appréciations et critiques, améliorations bienvenues. j' ai souhaité dessiner les symboles au moins une fois, en utilisant la création de blocs. Pas d' autres explications , c'est dans le code. A rajouter: le comptage et affichage du score.... Si ça ne marche pas, protester ici. Addiction interdite. 'definition des variables pour les 3 cartes (le 0 compte aussi) Dim carte(2) As AcadLWPolyline 'definition des points nécesssaires à la polyligne 4 sommets avec x et y pour chacun soit 8 valeurs en double précision Dim pt(0 To 15) As Double 'definition de la variable pour la largeur Dim largeur As Double ' definition de la variable pour la hauteur Dim hauteur As Double ' definition d' une varariable entier pour une boucle Dim fois As Integer ' definition d' une varariable entier pour l 'écart séparant 2 cartes Dim dep As Double ' definition d'une variable pour le chanfrein de la carte Dim ray As Double ' definition d'une variable pour verifier bloc existant Dim bloc As AcadBlock 'definition d' un contenant pour la liste de tirage. Dim liste As Variant Dim cp_liste As Variant Dim alea As Integer '----------------------- ' definition du point de centre de la carte Dim centre_carte(0 To 2) As Double 'definition de la position du symbole de la carte Dim pos_symbole(0 To 2) As Double 'definition de 3 arcs pour l 'as de coeur Dim arc(3) As AcadArc 'definition as de coeur comme région Dim as_de_coeur As AcadRegion '----------------------- 'definition des éléments necessaires a as de coeur 'liste d'entités qui composent le symbole coeur Dim liste_obj(3) As AcadEntity 'définition de la variable qui recevra la région Dim region As Variant 'définition des variables nécessaires à la hachure du symbole Dim hachure As AcadHatch Dim hachure_pique As AcadHatch Dim nom_motif As String Dim hachure_type As Long Dim associatif As Boolean Dim contour_hachure(0) As AcadEntity '----------------------- 'definition des blocs Dim pt_insertion(0 To 2) As Double Dim bloc_pied As AcadBlock Dim bloc_coeur As AcadBlock Dim bloc_pique As AcadBlock Dim bloc_trefle As AcadBlock '----------------------- 'definition des references de blocs Dim ref_coeur As AcadBlockReference Dim ref_pique As AcadBlockReference Dim ref_trefle As AcadBlockReference Dim calq1 As AcadLayer Dim calq2 As AcadLayer Dim calq_actif As AcadLayer '----------------------- 'definition des variables pour rejouer ou arreter Dim no_gagnant As Long Dim retour_carte As AcadLWPolyline Dim reponse As Integer 'definit variable pour verifier Dim verif As Integer Public Function DenR(angle) Pi = 4 * Atn(1) DenR = (angle * Pi) / 180 End Function Public Sub bonneteau_1() verif = 0 debut: pt_insertion(0) = 0: pt_insertion(1) = 0: pt_insertion(2) = 0 'valoriser les 3 paramètres de dimension et placement 'largeur = InputBox("Quelle est la largeur de la carte")'mettre en service ici pour la largeur de carte largeur = 10 'à supprimer si utlisation de la ligne supétieure. hauteur = largeur * 2 dep = largeur * 2 ray = largeur * 0.1 'positionne le symbole 'conforme aux tracés géométriques préconisés, mais à modifier suivant besoins 'cela permettra de changer le point de base si on fait tout un jeu un jour 'position en X pos_symbole(0) = pt_insertion(0) - (ray / 2) 'position en Y pos_symbole(1) = pt_insertion(1) + (ray) 'on reste sur le plan à 0 pos_symbole(2) = 0 'Stop 'Création des blocs si necessaires If verif = 0 Then coeur pied pique trefle End If 'Création des calques Set calq1 = ThisDrawing.Layers.Add("rouge_coeur_carreau") calq1.color = acRed Set calq2 = ThisDrawing.Layers.Add("noir_pique_trefle") calq2.color = acWhite 'la liste liste = Array("coeur", "pique", "trefle") cp_liste = liste 'création des cartes avec une boucle '3 tours For fois = 0 To 2 'point d' origine au tour suivant le placement du point d 'origine est augmenté de la variable de placement pt(0) = 0 + (dep * fois) + ray: pt(1) = 0 pt(2) = pt(0) + largeur - 2 * ray: pt(3) = pt(1) pt(4) = pt(2) + ray: pt(5) = pt(3) + ray pt(6) = pt(4): pt(7) = pt(3) + hauteur - ray pt(8) = pt(2): pt(9) = pt(3) + hauteur pt(10) = pt(0): pt(11) = pt(9) pt(12) = pt(0) - ray: pt(13) = pt(7) pt(14) = pt(12): pt(15) = pt(1) + ray 'creation de la carte proprement dit avec une polyligne 2d Set carte(fois) = ThisDrawing.ModelSpace.AddLightWeightPolyline(pt) 'propriété qui permet de fermer la polyligne sur son premier point carte(fois).Closed = True 'centre de la carte 'permettra les positionnements centre_carte(0) = pt(0) + (largeur / 2) - ray centre_carte(1) = hauteur / 2 centre_carte(2) = 0 'propriété qui permet d'avoir des coins arrondis For fois2 = 1 To 7 Step 2 carte(fois).SetBulge fois2, Tan(DenR(22.5)) Next fois2 'creation aleatoire pour dessinner les symboles Randomize alea = Int((2 * Rnd) + 0.5) While cp_liste(alea) = "rien" alea = Int((2 * Rnd) + 0.5) Wend 'Appel création de symbole Set calq_actif = ThisDrawing.ActiveLayer Select Case alea Case 0 ThisDrawing.ActiveLayer = calq1 Set ref_coeur = ThisDrawing.ModelSpace.InsertBlock(centre_carte, "coeur", 1, 1, 1, 0) Case 1 ThisDrawing.ActiveLayer = calq2 Set ref_pique = ThisDrawing.ModelSpace.InsertBlock(centre_carte, "pique", 1, 1, 1, 0) Case 2 ThisDrawing.ActiveLayer = calq2 Set ref_trefle = ThisDrawing.ModelSpace.InsertBlock(centre_carte, "trefle", 1, 1, 1, 0) End Select ThisDrawing.ActiveLayer = calq_actif cp_liste(alea) = "rien" Next fois 'reglage du zoom ThisDrawing.Application.ZoomExtents Dim pointz1(0 To 2) As Double Dim pointz2(0 To 2) As Double pointz1(0) = -(largeur / 2): pointz1(1) = 0: pointz1(2) = 0 pointz2(0) = largeur * 6: pointz2(1) = hauteur * 2.5: pointz2(2) = 0 ZoomWindow pointz1, pointz2 'boite de dialogue proposant de jouer If verif = 0 Then Dim Msg, Style, Titre Msg = "Jouer ?" ' Définit le message. Style = vbYesNo ' Définit les boutons. Titre = "Lancer le jeu" ' Définit le titre. ' Affiche le message. reponse = MsgBox(Msg, Style, Titre) End If 'efface les blocs ref_coeur.Delete ref_pique.Delete ref_trefle.Delete 'si reponse négative, sortir If reponse = 7 Then GoTo fin '--------------------------- 'seconde phase '--------------------------- 'affecte la carte gagnante Randomize alea = Int((2 * Rnd) + 0.5) no_gagnant = carte(alea).ObjectID 'Selection éventuelle de la carte gagnante 'MsgBox "Selectionnez l' as de coeur" 'Message d' invite, également sur la ligne de commande ThisDrawing.Utility.GetEntity retour_carte, basePnt, "Selectionnez l' as de coeur en cliquant sur le contour." If retour_carte.ObjectID = no_gagnant Then MsgBox "BRAVO, vous avez gagné !!!!" Else MsgBox "Malheureusement ce n 'est pas la bonne carte !" End If reponse = MsgBox("Voulez-vous rejouer ?", vbYesNo) If reponse = 6 Then For fois2 = 0 To 2 carte(fois2).Delete Next 'retourne à l 'étiquette debut en evitant la boite initiale verif = 1 GoTo debut End If fin: 'supprime les contours et les calques For fois2 = 0 To 2 carte(fois2).Delete Next calq1.Delete calq2.Delete ' Attention les blocs ne sont pas purgés. End Sub Public Sub coeur() '-------------------------- ' il s' agit ici d'un sous programme qui définit le bloc coeur. '-------------------------- Set bloc_coeur = ThisDrawing.Blocks.Add(pt_insertion, "coeur") 'traçage de arc1 supérieur gauche en reprenant le rayon défini pour l'arrondi et économiser les variables 'ceci est complètement arbitraire, à vous d 'innover sur ce point. ' l 'arc a besoin du centre, du rayon, de l'angle de départ en radian et de l'angle de fin en radian 'sens trigo 'on réutilise ici la fonction de MDSV31 pour la conversion degrés vers radians Set arc(0) = ThisDrawing.ModelSpace.AddArc(pos_symbole, ray, DenR(60), DenR(180)) 'miroir pour arc1 en symétrie avec 2 points Set arc(1) = arc(0).Mirror(arc(0).StartPoint, pt_insertion) 'traçage de arc3 inférieur gauche car je dispose maintenant du point final de 'arc1 qui devient le centre de arc3 Set arc(3) = ThisDrawing.ModelSpace.AddArc(arc(0).EndPoint, (3 * ray), DenR(300), DenR(360)) 'miroir pour arc2 en symétrie avec 2 points Set arc(2) = arc(3).Mirror(arc(0).StartPoint, pt_insertion) 'mettre les arcs dans la liste For fois2 = 0 To 3 Set liste_obj(fois2) = arc(fois2) Next 'Stop 'la region dans la variable variant region = ThisDrawing.ModelSpace.AddRegion(liste_obj) 'recupération de la région qui est la première et 'la seule créée présente dans la variable region 'il peut donc éventuellement y en avoir plusieurs Set as_de_coeur = region(0) as_de_coeur.Move arc(2).EndPoint, pt_insertion ' définition de la hachure nom_motif = "SOLID" hachure_type = acHatchPatternTypePreDefined associatif = True ' création de la hachure Set hachure = ThisDrawing.Blocks("coeur").AddHatch(hachure_type, nom_motif, associatif) Set contour_hachure(0) = as_de_coeur ' ajouter le contour et afficher la hachure hachure.AppendOuterLoop (contour_hachure) hachure.Evaluate hachure.color = acByLayer ThisDrawing.Regen True 'suppression du contour as_de_coeur.Delete arc(2).Delete End Sub Public Sub pied() '-------------------------- ' il s' agit ici d'un sous programme qui sera appelé par le programme principal. 'création du pied en bloc necessaire pour le pique et le trefle 'vous avez remarqué que c 'est la même figure à l 'envers 'avec les grands arcs inversés, ces arc ont été coservés après la création du coeur '-------------------------- Set bloc_pied = ThisDrawing.Blocks.Add(pt_insertion, "pied") 'miroir arc3 pour obtenir l 'inverse 'en utisant comme point de la ligne de symétrie les extrémités de arc3 Set arc(2) = arc(3).Mirror(arc(3).StartPoint, arc(3).EndPoint) 'supprime arc3 arc(3).Delete 'miroir arc2 pour obtenir l 'inverse Set arc(3) = arc(2).Mirror(arc(0).StartPoint, pt_insertion) 'transforme en region '--------------------------- 'pour faire une région, il faut une liste d' objets 'pour le nombre d' objets nécessaires à créer la région 'une region est dans une variable de type variant 'mettre les arcs dans la liste For fois2 = 0 To 3 Set liste_obj(fois2) = arc(fois2) Next 'la region dans la variable variant region = ThisDrawing.ModelSpace.AddRegion(liste_obj) 'recupération de la region qui est la première et 'la seule crée présente dans la variable region 'il peut donc éventuellement y en avoir plusieurs Set piedepique = region(0) 'retournement par rotation piedepique.Rotate arc(3).StartPoint, DenR(180) piedepique.Move arc(3).StartPoint, pt_insertion ' définition de la hachure nom_motif = "SOLID" hachure_type = acHatchPatternTypePreDefined associatif = True ' création de la hachure Set hachure = ThisDrawing.Blocks("pied").AddHatch(hachure_type, nom_motif, associatif) Set contour_hachure(0) = piedepique ' ajouter le contour et afficher la hachure hachure.AppendOuterLoop (contour_hachure) hachure.Evaluate hachure.color = acByLayer ThisDrawing.Regen True 'suppression des arcs maintenant inutiles, et du contour For fois2 = 0 To 3 arc(fois2).Delete Next piedepique.Delete End Sub Public Sub pique() '-------------------------- ' il s' agit ici d'un sous programme qui crée l' as de pique depuis les 2 blocs précédents '-------------------------- Set bloc_pique = ThisDrawing.Blocks.Add(pt_insertion, "pique") Set ref_pied = ThisDrawing.Blocks("pique").InsertBlock(pt_insertion, "pied", 0.8, 0.8, 0.8, 0) pt_insertion(1) = (3 * ray) + (ray / 2) Set ref_coeur = ThisDrawing.Blocks("pique").InsertBlock(pt_insertion, "coeur", 1, 1, 1, DenR(180)) pt_insertion(1) = 0 End Sub Public Sub trefle() '-------------------------- ' il s' agit ici d'un sous programme qui crée l 'as de trèle depuis les 2 premiers blocs '-------------------------- Set bloc_trefle = ThisDrawing.Blocks.Add(pt_insertion, "trefle") Set ref_coeur = ThisDrawing.Blocks("trefle").InsertBlock(pt_insertion, "coeur", 0.5, 0.5, 0.5, DenR(-100)) 'fait un réseau de 3 reseau = ref_coeur.ArrayPolar(3, DenR(200), pt_insertion) Set ref_pied = ThisDrawing.Blocks("trefle").InsertBlock(pt_insertion, "pied", 0.8, 0.8, 0.8, 0) End Sub

Bonsoir, En reprenant ce que tu as déjà: Sub longueurtotale() ' Create the selection set Dim sset As Object ThisDrawing.SelectionSets("SS1").Delete Set sset = ThisDrawing.SelectionSets.Add("SS1") ' Prompt the user to select objects sset.SelectOnScreen ' Define the variable Dim compteur As Double ' Loop through all entities in the selection ' set and assign the xdata to each entity Dim obj As AcadEntity Dim obj2 As AcadObject Dim Line As AcadLine Dim arc As AcadArc Dim poly As AcadLWPolyline For Each obj In sset MsgBox ("type de l'objet : " & obj.EntityType) If obj.EntityType = 19 Then MsgBox ("ligne trouvée !!") Set Line = obj compteur = compteur + Line.Length End If If obj.EntityType = 4 Then MsgBox ("arc trouvé !!") Set arc = obj compteur = compteur + arc.ArcLength End If If obj.EntityType = 24 Then MsgBox ("polyligne trouvée !!") Set poly = obj compteur = compteur + poly.Length End If Next obj MsgBox ("longueur totale :" & compteur & "m") ThisDrawing.SelectionSets("SS1").Delete End Sub

Bonsoir, Speedy: tu remplaces la ligne [surligneur] valeur=poly.area[/surligneur] par [surligneur]valeur= poly.length [/surligneur] Pour plus de sélection, sagit-il de plusieurs polylignes ? que souhaites-tu exactement. Nono64: il n 'est pas question de transformer du vba en Lisp. Si tu veux l 'utiliser, il ne s 'agit que d 'un exemple mais adaptable, va voir la procédure donnée par Sechanbask ici Je n 'ai pas précisé, mais il faut bien sûr charger depuis vba autocad, la bibliothèque des éléments Excel. Menu outils >> references >> Microsoft Excel object Library

Bonsoir, j'ai un vba qui enregistre dans la cellule B2 (par ex) du classeur "Classeur1.xls" sur C: la valeur de la surface d'une polyligne choisie à l 'écran. Dim returnObj As AcadObject Dim basePnt As Variant Dim poly As AcadLWPolyline Dim MyXL As Object Dim feuille As Worksheet Dim cellule As Range Public Sub aire_poly() ' récupère la surface d' une polyligne présente à l 'écran ThisDrawing.Utility.GetEntity returnObj, basePnt, "Selectionnez la polyligne" If returnObj.ObjectName = "AcDbPolyline" Then Set poly = returnObj valeur = poly.Area ' Définit la variable objet faisant référence au fichier à ouvrir. Set MyXL = GetObject("c:\Classeur1.XLS") MyXL.Application.Visible = True MyXL.Parent.Windows(1).Visible = True Set feuille = MyXL.Worksheets("Feuil1") 'enregistre dans la cellule B2 feuille.Cells(2, 2).Value = valeur End If 'Quitte excel qui demandera un enregistrement éventuel MyXL.Application.Quit End Sub

Bonsoir, Tu peux t' inspirer du fichier "homer" que tu trouveras ici. Dans ce fichier tu remplaces la partie entre {xxxx} par ta commande. Le reste est à adapter. [Edité le 6/11/2007 par nazemrap]

En fait, je m 'aperçois que le collage de mon code donne des trucs bizarres et incomplets. Je ne sais pas pourquoi ????? J ai essayé d 'éditer mais c 'est pas mieux. Que dois-je faire ?

Bonjour, ne s'agit-il pas plutôt de [surligneur]Pviewport [/surligneur] ? Si c 'est le cas, voici un exemple repris dans l 'aide. Sub Example_AddPViewport() ' paramètrage nouvelle fenetre flottante Dim pviewportObj As AcadPViewport Dim center(0 To 2) As Double Dim width As Double Dim height As Double center(0) = 3: center(1) = 3: center(2) = 0 width = 40 height = 40 'bacule en EP ThisDrawing.ActiveSpace = acPaperSpace 'création Set pviewportObj = ThisDrawing.PaperSpace.AddPViewport(center, width, height) ThisDrawing.Regen acAllViewports mise à l 'échelle correspondant à Zoom nXP pviewportObj.CustomScale = 20 End Sub [Edité le 2/11/2007 par nazemrap] [Edité le 2/11/2007 par nazemrap]

Bonjour, j 'ai peut-être pas bien compris la question, mais il me semble pourtant que l' état de visibilté est disponible dans les propriétés d' une référence de bloc. Aplus

Bonjour, Voici le sous-programme pour un as de coeur, qui devra être sans doute amélioré, mais il montre l 'utilisation de divers commandes de tracés de base. Il faudra le mettre en bloc. Il devra servir pour créer l 'as de pique, en le retournant et en ajoutant un "pied". Le "pied" est obtenu en inversant 2 arcs du coeur. L' as de trèfle utilisera 3 as de coeur et le même pied que l 'as de pique avec éventuellement des échelles différentes. Public Sub coeur() '----------------------- ' definition du point de centre de la carte Dim centre_carte(0 To 2) As Double 'definition de la position du symbole de la carte Dim pos_symbole(0 To 2) As Double 'definition de 4 arcs pour l 'as de coeur Dim arc(3) As AcadArc 'definition as de coeur comme région Dim as_de_coeur As AcadRegion 'definition des éléments necessaires à as de coeur 'liste d'entités qui composent le symbole coeur Dim liste_obj(3) As AcadEntity 'définition de la variable qui recevra la région Dim region As Variant 'définition des variables nécessaires à la hachure du symbole Dim hachure As AcadHatch Dim nom_motif As String Dim hachure_type As Long Dim associatif As Boolean Dim contour_hachure(0) As AcadEntity '----------------------- 'centre de la carte 'permettra les positionnements centre_carte(0) = pt(0) + (largeur / 2) - ray centre_carte(1) = hauteur / 2 centre_carte(2) = 0 'positionne le symbole par rapport au centre 'conforme aux tracés géométriques préconisés, mais à modifier suivant besoins 'cela permettra de changer le point de base si on fait tout un jeu un jour 'position en X pos_symbole(0) = centre_carte(0) - (ray / 2) 'position en Y pos_symbole(1) = centre_carte(1) + (ray) 'on reste sur le plan à 0 pos_symbole(2) = 0 'traçage de arc1 supérieur gauche en reprenant le rayon défini pour l'arrondi et économiser les variables 'ceci est complètement arbitraire, à vous d 'innover sur ce point. 'on réutilise ici la fonction de MDSV31 pour la conversion degrés vers radians Set arc(0) = ThisDrawing.ModelSpace.AddArc(pos_symbole, ray, DenR(60), DenR(180)) 'miroir pour arc1 en symétrie avec 2 points Set arc(1) = arc(0).Mirror(arc(0).StartPoint, centre_carte) 'traçage de arc3 inférieur gauche car je dispose maintenant du point final de 'arc1 qui devient le centre de arc3 Set arc(3) = ThisDrawing.ModelSpace.AddArc(arc(0).EndPoint, (3 * ray), DenR(300), DenR(360)) 'miroir pour arc2 en symétrie avec 2 points Set arc(2) = arc(3).Mirror(arc(0).StartPoint, centre_carte) 'mettre les arcs dans la liste For fois2 = 0 To 3 Set liste_obj(fois2) = arc(fois2) Next 'la region dans la variable variant region = ThisDrawing.ModelSpace.AddRegion(liste_obj) 'recupération de la région qui est la première et 'la seule créée présente dans la variable region 'NB:il peut donc éventuellement y en avoir plusieurs Set as_de_coeur = region(0) as_de_coeur.color = acRed 'suppression des arcs inutiles maintenant For fois2 = 0 To 3 arc(fois2).Delete Next ' définition de la hachure nom_motif = "SOLID" hachure_type = acHatchPatternTypePreDefined associatif = True ' création de la hachure Set hachure = ThisDrawing.ModelSpace.AddHatch(hachure_type, nom_motif, associatif) Set contour_hachure(0) = as_de_coeur ' ajouter le contour et afficher la hachure hachure.AppendOuterLoop (contour_hachure) hachure.Evaluate hachure.color = acRed ThisDrawing.Regen True End Sub Le code d 'appel à rajouter dans la procédure principale, signalé ici entre les traits. 'propriété qui permet d'avoir des coins arrondis For fois2 = 1 To 7 Step 2 carte(fois).SetBulge fois2, Tan(DenR(22.5)) Next fois2 '------------------------------------------------------------------------------------------------- 'Appel création de symbole pour l 'instant le coeur sur la première carte If fois = 0 Then coeur '------------------------------------------------------------------------------------------------- Select Case tirage Case fois datatype(0) = 1001: data(0) = "jeu de carte" datatype(1) = 1002: data(1) = "GAGNE" Juste pour signaler que la suite se trouve dans la rubrique "progammer en s' amusant" [Edité le 7/2/2008 par nazemrap]

Bonsoir, Bon,c 'est bien tout ça. J ai fait l 'as de coeur, mais je ne sais pas si je dois reposter tout le code ??? Pour l 'instant il s' agit de le tracer avec les arcs et hachure "solid" rouge, je pense qu 'il faudra envisager la création d 'un bloc qui sera plus facile à réutiliser. On verra demain. A plus

Bonjour, en utisant la commande " liste" tu auras la longueur. [Edité le 27/10/2007 par nazemrap]

Bonjour, Je pense qu 'il y a eu une mauvaise saisie au clavier, il doit s' agir de [surligneur]Rnd [/surligneur] qui génère un nombre aléatoire ? Pour le déroulement du jeu en lui-même, je pense qu 'il va exister pas mal de possibilités. le Xdata sera sans doute intéressant car plein de possibilités à faire connaître. La proposition des carrés et cercles est toujours valable, si d 'autres firgures sont proposées, il suffira de substituer. Voici la construction géométrique que j 'envisageais pour le coeur, qui sert de base aux autres. Ce sont des triangles isocèles, le rayon est le même que l 'arrondi des coins de cartes. http://www.premiumwanadoo.com/technaulogis/cadxp/bonneteau_02.jpg

Bonjour, Winfield, c' était donné dans le n° 14 par MDSV31.

Bon je pense qu 'on va utiliser tout ça. Quand même, moi j 'aurais bien aimé 3 as : un coeur, un pique un trèfle. Le coeur sert de base pour tracer les autres. http://www.premiumwanadoo.com/technaulogis/cadxp/bonneteau_01.jpg

Bon !! Joli appel de fonction ! ça avance bien, je crois que cette fois on peut garder le code de MDSV31. Si des commentaires, des variantes ou suggestion, n 'hésitez pas ! Quelles cartes choisit-on de représenter ? (ne demandez pas le valet de pique) Ps pour ceux qui reprennent le code n 'oubliez pas éventuellement la déclaration des variables. [Edité le 25/10/2007 par nazemrap]

Hello, Wouah!! trop drôle, je ne peux pas résister à mettre ce que j 'avais fait. Public Sub bonneteau_3() 'arrondir les angles avec la méthode bulge 'saisie de la largeur par une boite largeur = InputBox("Quelle est la largeur de la carte") hauteur = largeur * 2 dep = largeur * 2 ' le rayon sera proportionnel à la largeur rayon_coin = largeur / 10 'la boucle qui inclut cette fois 8 points qui permettront de "bulger" 'il est recommandé à ceux que cela intéresse d 'aller voir dans l' aide pour setbulge For fois = 0 To 2 pt(0) = 0 + (dep * fois) + rayon_coin: pt(1) = 0 pt(2) = pt(0) + largeur - (2 * rayon_coin): pt(3) = pt(1) pt(4) = pt(2) + rayon_coin: pt(5) = pt(3) + rayon_coin pt(6) = pt(4): pt(7) = pt(5) + hauteur - (2 * rayon_coin) pt(8) = pt(6) - rayon_coin: pt(9) = pt(7) + rayon_coin pt(10) = pt(8) - largeur + (2 * rayon_coin): pt(11) = pt(9) pt(12) = pt(10) - rayon_coin: pt(13) = pt(11) - rayon_coin pt(14) = pt(12): pt(15) = pt(13) - hauteur + (2 * rayon_coin) Set carte(fois) = ThisDrawing.ModelSpace.AddLightWeightPolyline(pt) carte(fois).Closed = True 'boucle imbriquée qui permet de réaliser l 'arrondi For coin = 1 To 7 Step 2 carte(fois).SetBulge coin, (1.414 * rayon_coin) / 4 Next Next End Sub C 'est pratiquement la même chose, mais plus propre pour MDSV31. Mais j 'ai pas honte, je joue le jeu, je savais bien que cela allait m'être profitable.... J 'ai rajouté un input pour la largeur de la carte, les autres dimensions sont en fonction. Pour le "SetBulge", je l' ai mis dans une boucle. J 'ai éxécuté les 2, j 'ai superposé, MDSV31 dépasse les 10. Fallait bien que je trouve quelque chose. Il reste le zoom étendu. Qu' est-ce qu' on fait maintenant ?

J 'ai vu, ça me parait intéressant à creuser. Toutefois j 'aurais besoin de quelques précisions, et pas tout de suite. Je suis un peu pris.

Hey, -MDSV31 : je ne connait pas d 'équivalant vba pour le rectangle, mais étant donné ma pratique, il est possible que qelquechose puisse exister.D' autres avis viendront peut-être. -Sechanbask : désolé pour ton pc. Je retiens l 'idée de mettre les cartes sur un calque différent, pour exploiter le tirage, ce sera sans doute Rnd, mais c 'est à mon avis un peu tôt. Le miroir va être à tester en effet, j 'espère que tu seras bientôt de nouveau opérationnel... Ce serait bien que ces challenges servent, à ceux qui le souhaitent, à s' initier à VBA. Pour ma part j 'envisage en rapport avec le code précédent, de récupérer la largeur de la carte avec une boite de saisie (fréquente en vba), ce qui permettra d 'adapter la dimension au goût de chacun. Seule la largeur est nécessaire pour l' instant pour induire le reste des opérations. Je souhaiterais aussi que les angles soient arrondis, et comme il s' agit d' une polyligne... Il faut sans doute envisager aussi un zoom étendu. Si il y a des amateurs ....

Hello, Heu!! J 'ai besoin de 4 points pour tracer 3 segments et donc de fermer la polyligne après le quatrième point pour rejoindre le premier. Si je ferme après le troisième j 'ai un triangle non ???

Soir, on attend Sechanbask, pour comparer, d' autres encore si des possibilités apparaissent. remarques, commentaires et orientations bienvenues. Suite à venir.

Salut, J 'avais pas vu ton message. Il n 'y a pas beaucoup de volontaires !!!! Tant pis, on continue. Vas y postes, je mets le mien aussi, on pourra comparer. J 'ai fait moi ausi une boucle, mais j 'ai inclu le déplacement dans la boucle. 'definition des variables pour les 3 cartes (le 0 compte aussi) Dim carte(2) As AcadLWPolyline 'definition des points nécesssaires à la polyligne 4 sommets avec x et y pour chacun soit 8 valeurs en double précision Dim pt(0 To 7) As Double 'definition de la variable pour la largeur Dim largeur As Double ' definition de la variable pour la hauteur Dim hauteur As Double ' definition d' une varariable entier pour une boucle Dim fois As Integer ' definition d' une varariable entier pour l 'écart séparant 2 cartes Dim dep As Double Public Sub bonneteau_1() 'valoriser les 3 paramètres de dimension et placement largeur = 10 hauteur = largeur * 2 dep = largeur * 2 'création des cartes avec une boucle '3 tours For fois = 0 To 2 'point d' origine au tour suivant le placement du point d 'origine est augmenté de la variable de placement pt(0) = 0 + (dep * fois): pt(1) = 0 ' second point bas droite pt(2) = pt(0) + largeur: pt(3) = pt(1) 'troisieme point au dessus du second pt(4) = pt(2): pt(5) = pt(3) + hauteur 'quatrième point en revenant au dessus du premier pt(6) = pt(4) - largeur: pt(7) = pt(5) 'creation de la carte proprement dit avec une polyligne 2d Set carte(fois) = ThisDrawing.ModelSpace.AddLightWeightPolyline(pt) 'propriété qui permet de fermer la polyligne sur son premier point carte(fois).Closed = True Next End Sub [Edité le 20/10/2007 par nazemrap]