Curlygoth

oui je suis d'accord. ben j'attends la réponse de @DenisHen

Non, c'etait pour mettre les failles de mon jeu de fléchette XD du coup... ben je les ai pas mise ^^

gile(s) je pense que tu te méprends : il est vrai que dans la collection linetypes, il y a bien "ByLayer" mais ça renvoie bien le type de ligne Continuous ^^

"ByLayer" c'est Ducalque et linetypes est une collection donc c'est normal. tu devrais en faire un complet et le "découper ensuite" pour "encore une fois" garder les sub et fonction et pas toujours copier coller ou réécrire le code déjà écrit...

Oui c'est ça et je conseil une nouvelle fois de créer des sub et fonction pour chaque petite tâche ça t'évitera de toujours "chercher" car tu as (je pense) tout ce qu'il faut pour ce que tu veux faire

Err.clear enleve les parenthèses et ta dernière ligne en rouge c'est l'application donc la besoin tu l'a déjà écrit dans ton code 😉

Regarde tes processus en cours... Attend il n'y a pas le create reprend le code que gile(s) t'avais donné pour ouvrir / cibler un dwg ! L'aide VBA https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/createobject-function

J'ai pas l'impression que ce bout de code récupére le "bon" dessin dans autocad... Si Didier a ouvert un seul dessin il va effectivement charger les types de lignes dans la collection que tu lui as indiquer mais si ton programme voit dessin1 ou juste l'objet autocad oui il ne t'en sortiras que 3...

Bonjour à vous, C'est bientôt Noël, et pour certains bientôt les vacances, et donc : Je vous envoie un mini jeu voir micro jeu... un jeu de fléchette (très simple) ! Je vous explique un peu : Deux modes de jeux 501 ou 301: On marque des points qu'on soustrait a notre score et si vous arrivez PILE à zéro vous gagner sinon vous perdez... Les petites zones extérieures doublent les points (afficher dans le prolongement du "triangle") il faut d'ailleurs finir sur l'une de ces cases ! Les petits zones intérieures triplent les points Au centre 50 Points pour la plus petite zone et 25 plus la plus grande ! Attention il faut Finir sur un double pour tombé à zéro (exemple si vous êtes à 8, il faut finir sur un 2x4 !) Plus le niveau est haut : plus vous serez précis (mais plus loin sera la cible) Plus le niveau est bas : vous serez prêt de la cible mais avec une précision moindre... (Je conseil le niveau 4) mais vous pouvez tout tester ^^ Pour lancer le jeu, il suffit de sauvegarder le dwg pour lancer le programme allez bonne fête de fin d'année ^^ - Configuration minimal : - Autocad version complète - Le module VBA video d'explication JEU_FLECHETTE_V2.zip

Bonjour, J'aimerais poster un sujet avec un spoiler du type balise [spoiler] un truc a cacher qui pourrais apparaitre une fois que l'utilisateur à envie de voir la fin du film par exemple [/spoiler]

[SPOILER] blabla [/spoiler]

Malheureusement, je n'ai pas Revit, mais fais toi une table de correspondance entre nature, diamètre, épaisseur etc... pour ensuite annoter en fonction de cette table 😉 plus ta table sera grande et plus ta pourra mettre d'infos dans ton annotation 😉

Je suis d'accord avec toi. mais je ne m’arrêterais pas à ça ! Si je peux faire plus, je ferais plus. Apprendre, comprendre et appliquer (s'éclater !)

j'ai pas non plus le prétention de développer les X millions de lignes mais certains de mes clients souhaitent une équivalence de certaines fonctionnalités. Foliotage / Cotation auto / fourreaux / module topo / etc... Hors sujet : WWWHHHAAATTT ??? lecrabe je savais... mais toi ? ok ben profite bien

Tu trouveras des indépendants comme (moi, didier, gile(s), rebcao... ) qui je pense peuvent te proposer des solutions moins onéreuse que Covadis... si tu n'utilise pas 100% de Covadis

.plottable = true 'or false tu as dans l'aide : je te le redis l'aide VBA est tres bien documenté ! abuses-en ! Sub Example_Plottable() ' This example creates a new layer called "New_Layer". It then uses ' the Plottable property of each Layer to display whether or not that layer ' is plottable. The user has the ability to toggle the plottable state ' for each layer, and the final plottable status for all layers is displayed. Dim layerObj As AcadLayer, tempLayer As AcadLayer Dim msg As String ' Add the layer to the layers collection Set layerObj = ThisDrawing.Layers.Add("New_Layer") ' Make the new layer the active layer for the drawing ThisDrawing.ActiveLayer = layerObj ' Cycle through the layers and allow user to make them plottable or not For Each tempLayer In ThisDrawing.Layers If tempLayer.Plottable Then ' Determine if this layer is plottable If MsgBox("The layer '" & tempLayer.name & "' will plot. Would you like to turn off plotting for this layer?", vbYesNo & vbQuestion) = vbYes Then tempLayer.Plottable = False ' Change plottable state End If Else If MsgBox("The layer '" & tempLayer.name & "' will not plot. Would you like to turn on plotting for this layer?", vbYesNo & vbQuestion) = vbYes Then tempLayer.Plottable = True ' Change plottable state End If End If Next ' Display the new plottable status of the layers in this drawing For Each tempLayer In ThisDrawing.Layers ' Determine if this layer is plottable If tempLayer.Plottable Then msg = msg & "The layer '" & tempLayer.name & "' will plot." & vbCrLf Else msg = msg & "The layer '" & tempLayer.name & "' will not plot." & vbCrLf End If Next MsgBox msg End Sub

Comme je le disais c'est une function donc avec un titre du type (marche aussi en sub puisque je ne renvoie pas de valeur) function BLOC_VERS_INT_3D(POLyobj3D) set poly3d = POLyobj3D 'le code end function ensuite il faut boucler sur les objet du style : sub test For i = 0 To ThisDrawing.ModelSpace.Count - 1 Set Entity = ThisDrawing.ModelSpace.Item(i)for i if Entity.ObjectName = "AcDb3dPolyline" then call BLOC_VERS_INT_3D(Entity) else end if next i end sub Function RECH_BLOCK_EXTREMITE(polyobj) l_point = polyobj.Coordinates dim table(0 to 1) E1(0) = l_point(0) E1(1) = l_point(1) E2(0) = l_point(UBound(l_point) - 1) E2(1) = l_point(UBound(l_point)) For E = 0 To ThisDrawing.ModelSpace.Count - 1 Set Entity = ThisDrawing.ModelSpace.Item(E) If Entity.ObjectName = "AcDbBlockReference" D1 = MATH.HYPOTHENUSE_2PT(E1, blockrefobj.InsertionPoint) If D1 < 0.001 Then table(0) = blockrefobj.handle Else D2 = MATH.HYPOTHENUSE_2PT(E2, blockrefobj.InsertionPoint) If D2 < 0.001 Then table(1) = blockrefobj.handle Else End If End If next E RECH_BLOCK_EXTREMITE =table end function

A mettre dans la boucle de recherche de tes poly3D Les block se supprimeront et le point d'insertion ce mettre a 20cm vers le point opposé si les block ne sont pas propre suffit de faire la différences et les déplacer via .move Dim blockrefobj1 As AcadBlockReference Dim blockrefobj2 As AcadBlockReference Dim poly3D As Acad3DPolyline Dim pT1(0 To 2) As Double Dim pT2(0 To 2) As Double Dim P1(0 To 2) As Double Dim P2(0 To 2) As Double DELTA = 0.2 L_COORD = poly3D.Coordinates For i = 0 To 5 If i < 3 Then pT1(i) = L_COORD(i) Else pT2(i - 3) = L_COORD(i) End If Next i L_Blockrefobj = AUTOCAD_CTRL.RECH_BLOCK_EXTREMITE(poly3D) Set blockrefobj1 = AUTOCAD_CTRL.HANDLE_TO_OBJET(L_Blockrefobj(0)) B1 = blockrefobj1.EffectiveName blockrefobj1.Delete Set blockrefobj2 = AUTOCAD_CTRL.HANDLE_TO_OBJET(L_Blockrefobj(0)) B2 = blockrefobj2.EffectiveName blockrefobj2.Delete D = poly3D.Length 'ou MATH.HYPOTHENUSE_2PT(pT1, pT2, True) A_X_Y = MATH.ANGLE_XY_2PTS(pT1, pT2) P1(0) = pT1(0) + DELTA * Cos(A_X_Y) P1(1) = pT1(1) + DELTA * Sin(A_X_Y) P1(2) = MATH.Z_ENTRE_2_POINTS(D, pT1(2), pT2(2), DELTA) P2(0) = pT1(0) + (D - DELTA) * Cos(A_X_Y) P2(1) = pT1(1) + (D - DELTA) * Sin(A_X_Y) P2(2) = MATH.Z_ENTRE_2_POINTS(D, pT1(2), pT2(2), D - DELTA) Set blockrefobj1 = ThisDrawing.ModelSpace.InsertBlock _ (P1, B1, Echelle_X, Echelle_Y, Echelle_Z, Rotation_Bloc) Set blockrefobj2 = ThisDrawing.ModelSpace.InsertBlock _ (P2, B2, Echelle_X, Echelle_Y, Echelle_Z, Rotation_Bloc) Function Z_ENTRE_2_POINTS(D, Z1, Z2, DIST_ENTRE_PTBASE_ET_PT_ZRECH) Z_ENTRE_2_POINTS = Z1 + (DIST_ENTRE_PTBASE_ET_PT_ZRECH - 0) * ((Z2 - Z1) / (D)) End Function

VBA accepté ?

d'ailleurs une fonction d'importation de .bas est utile quand tu en serais à beaucoup de modules nommé XD (je l'ai pas encore fait mais je vais devoir le faire j'ai 53 modules...)

Fait des function pour les réutiliser ! Une fonction pour lire le TXT Une pour mettre tes variables à 0 ou "" une autre pour chercher un fichier de cette manière te pourra les réemployer n'importe où ! et n'importe quand !

oui tu as bon ! mais créer un type de ligne pour voir comment le dxf se genère et ensuite pouvoir le traité !! et programmer en conséquence

et tu as effectivement les définition de ligne ! je l'ai ai trouver ! tu as effectivement "AcDbLinetypeTableRecord" & chr(10) & " " & 2 il faut traiter entre ça et l'autre defintion qui est la suite ! les caractères entre les données faut juste les enlever et trim c'est pour les espaces travaille en array je te conseil de creer une ligne ou tu connais la definition et ensuite regarder comment est generer le dxf pour comprendre comment extraire le(s) type(s) de ligne(s) (ca marche)

et ben ? fonction instr ! tu auras la position dans le string ! donc tu cherches : "AcDbLinetypeTableRecord" & chr(10) & " " & 2

C'est la base d'ouvrir / editer / creer des txt en vba ! donc rattrape le temps perdu avec ce tuto : https://warin.developpez.com/access/fichiers/#LII