Curlygoth

Programmation ? il y a eu un topic ici

Bonjour à vous, Je souhaite importer mon cuix vers le poste de mon remplaçant Les boutons fonctionnent, mais certaines images de mes boutons ne s'affichent pas... enfin Autocad met une image de nuage avec un "?" Après avoir été dans les options pour y mettre le dossier de mes images et dvb (dans un même dossier local) dans les : Chemin de recherche de fichiers de support en cours d'utilisation Chemin de recherche de fichiers de support Emplacements approuvés puis appliquer Que je vais dans Outil => Personnalisation => Menu... Mes images sont bien visible dans les commandes mais pas dans ma barre d'outil... et c'est là que je ne comprends pas (ais je oublié quelque chose ?) A et j'ai fermer et rouvert autocad (pourquoi pas) mais rien n'y fait... Voila s'il y a des perosnnes qui ont une idée 😉 je suis preneur sinon ben tant pis XD

je pense qu'avec la page que Didier à fait sur les type de ligne. Il est possible de créer un générateur de type de ligne 😉 Par contre, le problème que j'ai avec ce générateur (et donc c'est pour ça que je ne le poste pas) c'est que les caractères n'ont pas la même largeur... Donc pour simplifier, j'ai pris une "moyenne" large donc j'ai un blanc à la fin plus grand que celui du début... mais le jour ou j'ai toutes mes largeurs de chaques caractères je serais content ^^

Hello ami "extrudeur" Sur autocad j'ai pas vu l'option et je t'avouerais n'avoir qu'une tête (d'impression) par contre cherche du côté de meshmixer 😉 Lui le fera c'est sur 😉 et en français : bonne impression l'ami

Bonjour didier J'ai malheureusement écrit le code de mon quickhull un peu vite... donc c'est une car mon code . mais je me rapproche de la vérité 😉

fausse alerte... ne prends pas en compte certains exceptions

VBA language de programmation ? L'éternel débat... Je vous laisse vous battre sur sujet... Personnellement je m'en fiche tant que tu écris et ça fait ce que tu veux faire...

Méthode : obj.copy pt1,pt2 pt1 point de base (peut être 0,0,0) PT2 point de destination Pour toi : PT2(0) = PT1(0) PT2(1) = PT1(0)+50 PT2(2) = PT1(2) EDIT : Jamais essayé sur une sélection désolé ^^ (mais tu peux toujours parcourir ta sélection)

A ??? .. Je regarde... A ben.. oui.. Effectivement methode ".backgroundfill" autant pour moi 😆 Note à moi même : La programmation abusive nuit à la connaissance de base autocad

Oui Si ton style de ligne de repère courant est celui que tu veux avec des propriétés que te veux : je dis oui aussi

la j'avouerais que je finalise mes dossiers au boulot :-s donc a part aider un peu de loin... mais oui mais pourquoi pas dès que j'aurais plus de temps (Travaux maison, Prépa départ entreprise, reprise sport)

Extrait de l'aide pour .additem 🙂 : remarks : Objects currently in the specified selection set remain in the selection set. To replace the objects in the selection set, clear the selection set using the Clear method, then add the objects. Sub Example_AddItems() ' This example creates a selection set and several objects. ' It then adds the objects to the selection set. ' Create the new selection set Dim ssetObj As AcadSelectionSet Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SELECTIONSET") ' Create a Ray object in model space Dim rayObj As AcadRay Dim basePoint(0 To 2) As Double Dim SecondPoint(0 To 2) As Double basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0# SecondPoint(0) = 1#: SecondPoint(1) = 3#: SecondPoint(2) = 0# Set rayObj = ThisDrawing.ModelSpace.AddRay(basePoint, SecondPoint) ' Create a polyline object in model space Dim plineObj As AcadLWPolyline Dim points(0 To 5) As Double points(0) = 3: points(1) = 7 points(2) = 9: points(3) = 2 points(4) = 3: points(5) = 5 Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points) plineObj.Closed = True ' Create a line object in model space Dim lineObj As AcadLine Dim startPoint(0 To 2) As Double Dim endPoint(0 To 2) As Double startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0 endPoint(0) = 2: endPoint(1) = 2: endPoint(2) = 0 Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint) ' Create a circle object in model space Dim circObj As AcadCircle Dim centerPt(0 To 2) As Double Dim radius As Double centerPt(0) = 20: centerPt(1) = 30: centerPt(2) = 0 radius = 3 Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius) ' Create an ellipse object in model space Dim ellObj As AcadEllipse Dim majAxis(0 To 2) As Double Dim center(0 To 2) As Double Dim radRatio As Double center(0) = 5#: center(1) = 5#: center(2) = 0# majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0# radRatio = 0.3 Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio) ZoomAll ' Iterate through the model space collection. ' Collect the objects found into an array of objects ' to be added to the selection set. ReDim ssobjs(0 To ThisDrawing.ModelSpace.count - 1) As AcadEntity Dim I As Integer For I = 0 To ThisDrawing.ModelSpace.count - 1 Set ssobjs(I) = ThisDrawing.ModelSpace.Item(I) Next ' Add the array of objects to the selection set ssetObj.AddItems ssobjs ThisDrawing.Regen acActiveViewport End Sub j'utilise ce principe pour ajouter des objet dans un groupe.. j'ai pas besoin de sléction pou les groupe c'est .AppendItems

Tu fais par sélection d'objet ou un point pour définir ta hachure ?

Pour revenir à l'ajout à une sélection : selection.AddItems objet_new et set objet_new = ton objet 😉

sinon autocad c'est mal si tu fais pas (trop) de 3D maillé 😉

Moi je veux savoir ce qu'il en fait une fois dans sa sélection justement ^^'

yes ^^

alors je comprends pas XD Dessine moi le bloc final ("1 dessin vaut 1000 mots")

ok et plutot que tu tout sélectionner puis enlever pourquioi tu n'essairais pas l'inverse ? Sélectionner tes blocs entre tes Deux valeur de Y ?

alors je l'ai et effectivement c'est 2 attributs différents et tu veux qu'il est la meme valeur ? et soit afficher quand tu sélectionne descentes complete ? ben voila ... enfin regarde (j'ai fais ce que je t'ai dit 😉 ) et j'espere que ça va ^^ Test.dwg

si tu as besoin n'hésite pas 😉

donne nous le bloc on va regarder ^^ mais il faudrait peut être de l'attribut diamètre soit toujours visible clique droit dessus et va dans état de visibilité tu dois avoir l'option objet visible dans tous les état je crois

alors sache qu'au pire j'écris le code quand je peux j'avance pas assez vite... mais j'avance petit à petit, j’espère clôturer mon quickhull (au début adapter pour 4 pts mais je vise un peux plus pour le challenge) un extrait pour ta patience ? Je suis en train d'écrire le QuickHull (en fin de code) '''PARTIE FONCTION MATH Function Hypothenuse(DX, DY) Hypothenuse = Sqr(DX * DX + DY * DY) End Function Function PI() PI = 4 * Atn(1) End Function Function MATH_AX_B_2PTS(Pt1, PT2) 'Ax+B Dim c(0 To 1) As Double c(0) = (PT2(1) - Pt1(1)) / (PT2(0) - Pt1(0)) 'A c(1) = PT2(1) - c(0) * PT2(0) 'B MATH_AX_B_2PTS = c End Function Function MATH_DISTANCE_PT_DROITE(a, b, PT) NUMERATEUR = Abs(a * PT(0) - PT(1) + b) DENOM = Sqr((a ^ 2 + 1)) MATH_DISTANCE_PT_DROITE = NUMERATEUR / DENOM End Function Function MATH_AX_B_PERPENDICULAIRE(a, b, PT) Dim c(0 To 1) As Double c(0) = 1 / (-a) c(1) = PT(1) - a * PT(0) MATH_AX_B_PERPENDICULAIRE = c End Function Function MATH_PT_INTERSECTION_2_DROITE(A1, B1, A2, B2) Dim c(0 To 1) As Double X = (B2 - B1) / (A1 - A2) Y = A1 * X + B1 c(0) = X c(1) = Y MATH_PT_INTERSECTION_2_DROITE = c End Function Function MATH_ALTI_POINT_TRIANGLE(PA, PB, PC, Pm) Vab = VECTEUR(PA, PB) Vac = VECTEUR(PA, PC) VN = PROD_VECTEUR(Vab, Vac) MATH_ALTI_POINT_TRIANGLE = Z_VECTEUR_NORMAL_Pa(PA, Pm, VN) End Function Function VECTEUR(PA, PB) Dim V(0 To 2) As Double For i = 0 To 2 V(i) = PB(i) - PA(i) 'Vecteur ab Next i VECTEUR = V End Function Function PROD_VECTEUR(Vab, Vac) Dim V(0 To 2) As Double V(0) = Vab(1) * Vac(2) - Vab(2) * Vac(1) V(1) = Vab(2) * Vac(0) - Vab(0) * Vac(2) V(2) = Vab(0) * Vac(1) - Vab(1) * Vac(0) PROD_VECTEUR = V End Function Function Z_VECTEUR_NORMAL_Pa(PA, Pm, VN) T1 = PA(0) * VN(0) + PA(1) * VN(1) T2 = PA(2) * VN(2) T3 = Pm(0) * VN(0) T4 = Pm(1) * VN(1) Z_VECTEUR_NORMAL_Pa = (T1 + T2 - T3 - T4) / VN(2) 'z4 = (x1*xn + y1*yn + z1*zn – x4*xn – y4*yn) / zn End Function Function DotProduct(v1 As Variant, v2 As Variant) As Double 'Produit scalaire par (gile) DotProduct = v1(0) * v2(0) + v1(1) * v2(1) + v1(2) * v2(2) End Function Function POINT_ON_POLY(PolyLigne, Pt1) Dim NbrePoints As Integer Dim Pt1(0 To 2) As Double Dim PT2(0 To 2) As Double Dim Ray As AcadRay Dim Points As Variant PT2(0) = Pt1(0) + 1 PT2(1) = Pt1(1) PT2(2) = Pt1(2) Set Ray = ThisDrawing.ModelSpace.AddRay(Pt1, PT2) ' Calcul du nombre de points d'intersection Points = PolyLigne.IntersectWith(Ray, acExtendNone) NbrePoints = UBound(Points) / 3 ' Détermination en fonction de la parité If NbrePoints Mod 2 = 0 Then 'MsgBox "Le point n'est pas dans le contour" POINT_ON_POLY = True Else 'MsgBox "Le point est dans le contour" POINT_ON_POLY = True End If Ray.Delete End Function Function PT_AU_DESSUS_DROITE(a, b, PT) Y = PT(0) * a + b If Y >= PT(1) Then PT_AU_DESSUS_DROITE = False Else PT_AU_DESSUS_DROITE = True End If End Function Function AJ_POINT_PO(plineObj, Num_vertex, PT) Dim newVertex(0 To 1) As Double newVertex(0) = PT(0) newVertex(1) = PT(1) plineObj.AddVertex Nun_vertex, newVertex plineObj.Closed = True AJ_POINT_PO = Num_vertex End Function Function POINT_SOMMET_POLY(Poly, PT) Dim PT_PO(0 To 1) As Double POINT_SOMMET_POLY = False d_D = 0.0001 COORD = Poly.Coordinates For j = 0 To UBound(COORD) Step 2 D_X = PT_PO(j) - PT(0) D_Y = PT_PO(j + 1) - PT(1) If FONCT.Hypothenuse(D_X, D_Y) < d_D Then POINT_SOMMET_POLY = True Exit Function Else End If Next j End Function Function POINT_D_MAX(Poly, LIST_POINT, NB_POINT, AX_B_, AU_DESSUS) 'Sous la forme L_POINT(XYZ, X) X nombre de points,XYZ min = 1 D_MAX = 0 For POINT = 0 To NB_POINT P_T(0) = LIST_POINT(0, POINT) P_T(1) = LIST_POINT(1, POINT) If POINT_SOMMET_POLY(Poly, P_T) = False Then If AU_DESSUS = PT_AU_DESSUS_DROITE(AX_B_(0), AX_B_(1), P_T) Then If D = "" Then D_MAX = FONCT.MATH_DISTANCE_PT_DROITE(AX_B_(0), AX_B_(1), P_T) D = FONCT.MATH_DISTANCE_PT_DROITE(AX_B_(0), AX_B_(1), P_T) POINT_D_MAX = P_T(0) & ";" & P_T(1) Else D = FONCT.MATH_DISTANCE_PT_DROITE(AX_B_(0), AX_B_(1), P_T) If D > D_MAX Then POINT_D_MAX = P_T(0) & ";" & P_T(1) Else End If End If Else End If Else End If Next POINT End Function Function RECH_DES_4_POINTS_LES_PLUS_PROCHES(Pp1, NOM_BLOC) Dim TABL(4, 3) As Variant Dim temp As Long Dim blockRefObj As AcadBlockReference X = 0 Y = 1 Z = 2 D = 3 temp = -1 For ent = 0 To ThisDrawing.ModelSpace.Count - 1 Set entity = ThisDrawing.ModelSpace.Item(ent) If entity.ObjectName = "AcDbBlockReference" Then Set blockRefObj = entity If blockRefObj.EffectiveName = NOM_BLOC Then '"PTTOPO" 'DIST = FONCT.Hypothenuse(blockRefObj.InsertionPoint(X) - Pp1(X), blockRefObj.InsertionPoint(Y) - Pp1(Y)) D_X = blockRefObj.InsertionPoint(X) - Pp1(X) D_Y = blockRefObj.InsertionPoint(Y) - Pp1(Y) DIST = FONCT.Hypothenuse(blockRefObj.InsertionPoint(X) - Pp1(X), blockRefObj.InsertionPoint(Y) - Pp1(Y)) temp = temp + 1 If temp <= 4 Then Else temp = 4 End If For i = X To Z TABL(temp, i) = blockRefObj.InsertionPoint(i) Next i TABL(temp, D) = DIST Call Tri_2D(TABL, 0, temp, 3) Else End If Else End If Next ent RECH_DES_4_POINTS_LES_PLUS_PROCHES = TABL End Function Function CALCUL_Z_DANS_TRIANGLE_Z(Pa2D, Pb2D, Pc2D) Pa2D(2) = 0 Pb2D(2) = 0 Pc2D(2) = 0 Vab = FONCT.VECTEUR(Pa2D, Pb2D) Vac = FONCT.VECTEUR(Pa2D, Pc2D) Vam = FONCT.VECTEUR(Pa2D, M) Vba_ = FONCT.VECTEUR(Pb2D, Pa2D) Vbc = FONCT.VECTEUR(Pb2D, Pc2D) Vbm = FONCT.VECTEUR(Pb2D, M) Vca = FONCT.VECTEUR(Pc2D, Pa2D) Vcm = FONCT.VECTEUR(Pc2D, M) PV1_1 = FONCT.PROD_VECTEUR(Vab, Vam) PV1_2 = FONCT.PROD_VECTEUR(Vam, Vac) PV2_1 = FONCT.PROD_VECTEUR(Vba_, Vbm) PV2_2 = FONCT.PROD_VECTEUR(Vbm, Vbc) PV3_1 = FONCT.PROD_VECTEUR(Vca, Vcm) PV3_2 = FONCT.PROD_VECTEUR(Vcm, Vcm) PROD_SCAL_1 = FONCT.DotProduct(PV1_1, PV1_2) PROD_SCAL_2 = FONCT.DotProduct(PV2_1, PV2_2) PROD_SCAL_3 = FONCT.DotProduct(PV3_1, PV3_2) If PROD_SCAL_1 >= 0 And PROD_SCAL_2 >= 0 And PROD_SCAL_2 >= 0 Then Z = FONCT.MATH_ALTI_POINT_TRIANGLE(Pt1, PT2, pt3, P) pr(0) = P(0) pr(1) = P(1) pr(2) = Z Else End If End Function '''''''''''''''''''''''''''''''' ''''TRI A BULLE PAS DE MOI !!!! '''''''''''''''''''''''''''''''''' Public Sub Tri_2D(ByRef Tableau As Variant, _ mini As Long, _ Maxi As Long, _ Optional Colonne As Long = 0) Dim i As Long, j As Long, Pivot As Variant, TableauTemp As Variant, ColTemp As Long On Error Resume Next i = mini: j = Maxi Pivot = Tableau((mini + Maxi) \ 2, Colonne) While i <= j While Tableau(i, Colonne) < Pivot And i < Maxi: i = i + 1: Wend While Pivot < Tableau(j, Colonne) And j > mini: j = j - 1: Wend If i <= j Then ReDim TableauTemp(LBound(Tableau, 2) To UBound(Tableau, 2)) For ColTemp = LBound(Tableau, 2) To UBound(Tableau, 2) TableauTemp(ColTemp) = Tableau(i, ColTemp) Tableau(i, ColTemp) = Tableau(j, ColTemp) Tableau(j, ColTemp) = TableauTemp(ColTemp) Next ColTemp Erase TableauTemp i = i + 1: j = j - 1 End If Wend If (mini < j) Then Call Tri_2D(Tableau, mini, j, Colonne) If (i < Maxi) Then Call Tri_2D(Tableau, i, Maxi, Colonne) End Sub '''''''''''''CODE EN COURS d'ECRITURE !!!!!! Function QUICKHULL(L_POINT, NB_POINT) 'Sous la forme L_POOINT(XYZ, X) X nombre de points,XYZ min = 1 L_bound = 0 U_BOUND = NB_POINT 'Recherche des points extremes gauche et point droit Dim AX_B() Dim PT_GAUCHE(0 To 1) As Double Dim PT_DROIT(0 To 1) As Double Dim POLYPOINT(0 To 3) As Double For i = L_bound To U_BOUND If i = 0 Then PT_GAUCHE(0) = L_POINT(0, i) PT_GAUCHE(1) = L_POINT(1, i) PT_DROIT(0) = L_POINT(0, i) PT_DROIT(1) = L_POINT(1, i) Else If L_POINT(0, i) < PT_GAUCHE(0) Then PT_GAUCHE(0) = L_POINT(0, i) PT_GAUCHE(1) = L_POINT(1, i) Else End If If L_POINT(0, i) > PT_DROIT(0) Then PT_DROIT(0) = L_POINT(0, i) PT_DROIT(1) = L_POINT(1, i) Else End If End If Next i POLYPOINT(0) = PT_DROIT(0) POLYPOINT(1) = PT_DROIT(1) POLYPOINT(2) = PT_GAUCHE(0) POLYPOINT(3) = PT_GAUCHE(1) Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(POLYPOINT) AX_B_0 = FONCT.MATH_AX_B_2PTS(PT_GAUCHE, PT_DROIT) ReDim Preserve AX_B(0) AX_B(0) = AX_B_0 Dim PT_TEMP(0 To 2) 'Point au dessus PT_DESSUS = True dr = 0 For i = L_bound To U_BOUND PT_TEMP(0) = L_POINT(0, i) PT_TEMP(1) = L_POINT(1, i) If POINT_SOMMET_POLY(plineObj, PT_TEMP) = False Then D = FONCT.MATH_DISTANCE_PT_DROITE(AX_B(dr)(0), AX_B(dr)(1), PT_TEMP) If PT_AU_DESSUS_DROITE(AX_B(0), AX_B(1), PT_TEMP) = PT_DESSUS Then Nb_vertex = AJ_POINT_PO(plineObj, 1, PT_TEMP) + 1 Else End If Else End If Next i End Function Merci de ne pas porter de jugement !!!! C'est V0.0 XD donc même pas fini XD Je vais ajouter un point a ma polyligne ensuite vérifier les points encore au dessus des 2 segments créés ! D'ailleurs peut etre gérer par rapport a la polyligne plutot qu'aux points d'ailleurs.... bon ben je vais modifier ça XD

Tu ne te trompe pas ;-) ça dépend de ce que tu veux en faire 😉 et tu peux toujours vider ta "selection" pour le re-remplir ou créer une autre "table" ou créer une selection01 et il mettre les entity que tu veux garder pour filtrer ton traitement final PS : Personnellement, je fais une méthode moins efficace que la méthode de (Gile) et je parcours TOUS mes objets de mon dessin pour les filtrer moi même et agir directement dessus c'est plus long mais vu que je fais un traitement complet c'est plus pratique pour moi

Et du coup : Tu veux les sélectionner (comme on sélectionne des objets dans un dessin ) ou juste avoir un jeu de sélection via code ? Sinon la méthode de (gile) est la mieux en efficacité ! et pour gérer les paramètre des bloc dynamique : où set objet = blockRefObj 'pour adapter avec le code de (gile) dybprop = blockRefObj.GetDynamicBlockProperties For i = LBound(dybprop) To UBound(dybprop) If dybprop(i).PropertyName = "NOM_VAR_DYN" Then 'code pour gérer suivant le nom des propriété dynamique if dybprop(i).Value = VAR then 'code pour gérer les blocs avec une valeur next i