ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/Intersections.vb
(Generate patch)

Comparing magicsld/Intersections.vb (file contents):
Revision 48 by bournival, Wed Aug 22 21:18:12 2007 UTC vs.
Revision 205 by bournival, Thu Jul 23 20:53:57 2009 UTC

# Line 9 | Line 9 | Module Intersections
9      Public DefAttrRCCoque As SldWorks.AttributeDef
10      Public DefAttrFaceInterne As SldWorks.AttributeDef
11      Public DefAttrDoublon As SldWorks.AttributeDef
12 <    Public DefAttrIgnorer As SldWorks.AttributeDef
12 >    Public DefAttrIgnorer As sldworks.AttributeDef
13  
14      Public nbMinipoutre As Long
15  
16 +    Public lst_InterCoqueCoque As New Collections.Generic.List(Of InterCoqueCoque)
17  
18 +    Public MettreMiniPoutresSurFaceInternes As Boolean
19 +    Public MultiDecoupageCoques As Boolean = False
20 +    Public SectionSimpleSurPoutre As Boolean
21  
22   #Region "Enums"
23      Public Enum typeInterPoutreVolume
# Line 34 | Line 38 | Module Intersections
38          swApp.SetUserPreferenceIntegerValue(swconst.swUserPreferenceIntegerValue_e.swAutoSaveInterval, 0)
39          swModel.SetAddToDB(True)
40          swModel.SetDisplayWhenAdded(False)
41 +        swModel.SetInferenceMode(False)
42          ' ******
43          ' fin des options de performance
44          ' ******
45  
46 +
47 +
48          Memoriser3iemePoint() ' mémorise le coord system car si on découpe, sa coordonnée est perdue.
49 +
50          CouperPoutres()
51          Commun.GenererListes() ' va ignorer les poutres à ignorer... et ajouter les poutres coupées dans la liste.
52  
53 +        lst_InterCoqueCoque.Clear()
54 +        DetectionCoqueCoque()
55 +        DetectionPoutresVolumes() ' doit être avant interpoutreCoque au cas où on aurait une poutre de section
56 +        DetectionPoutresCoques()
57 +        DetectionCoqueVolume()
58  
59  
47        ' Traitement des intersection poutres-Volumes
48        DetectionPoutresVolumes()
49        DecouperPoutreVolume()
50        ' fin traitement intersection poutres-volumes
60  
52        swModel.EditRebuild3()
61  
62  
63  
64 +        ' Traitement des intersection poutres-Volumes
65 +        DecouperPoutreVolume()
66 +        swModel.EditRebuild3()
67 +
68          ' Traitement des intersection entre poutre et coques
57        DetectionPoutresCoques()
69          DecouperPoutreCoque()
70 <        ' Fin du traitement des intersections entre poutre et coques
60 <
70 >        swModel.EditRebuild3()
71  
72          ' traitement des coques-volumes
63        DetectionCoqueVolume()
73          DécouperCoqueVolume()
74 <        ' fin traitement coque volume
74 >        swModel.EditRebuild3()
75  
76          ' traitement des coques-coques
68        DetectionCoqueCoque()
77          DecouperCoqueCoque()
78 <        '
78 >        swModel.EditRebuild3()
79 >
80  
81  
82  
# Line 78 | Line 87 | Module Intersections
87          swModel.SetAddToDB(False)
88          swModel.SetDisplayWhenAdded(True)
89          swModel.GraphicsRedraw2()
90 +        swModel.SetInferenceMode(True)
91          ' ******
92          ' fin des options de performance
93          ' ******
# Line 94 | Line 104 | Module Intersections
104      Private Sub DecouperCoqueCoque()
105          Dim rayon As Double
106  
107 +        For Each interCC As InterCoqueCoque In lst_InterCoqueCoque
108 +            'rayon = IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2.GetEpaisseur, interCC.sFaceCoque1.GetEpaisseur)
109 +            'MsgBox("Traitement de l'intersection de coque - coque # " & interCC.Numero)
110 +
111 +            Try
112 +                If interCC.DoitCouperCoque1 Then
113 +                    rayon = interCC.sFaceCoque2.GetEpaisseur / 2
114 +                    Dim sweep As sldworks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
115 +                    interCC.DecouperCoque(interCC.sFaceCoque1, sweep)
116 +                    If Intersections.MettreMiniPoutresSurFaceInternes Then interCC.MarquerFacesInternes(interCC.sFaceCoque2, interCC.sFaceCoque1)
117 +                End If
118  
119 <        For Each Coque As SlyFaceCoque In Commun.lst_FaceCoque
120 <            For Each interCC As InterCoqueCoque In Coque.lst_InterCoqueCoque
121 <                rayon = IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2.GetEpaisseur, interCC.sFaceCoque1.GetEpaisseur)
122 <                Dim sweep As SldWorks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
123 <                interCC.DecouperCoque(Coque, sweep)
119 >                If interCC.DoitCouperCoque2 Then
120 >                    rayon = interCC.sFaceCoque1.GetEpaisseur / 2
121 >                    Dim sweep As sldworks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
122 >                    interCC.DecouperCoque(interCC.sFaceCoque2, sweep)
123 >                    If Intersections.MettreMiniPoutresSurFaceInternes Then interCC.MarquerFacesInternes(interCC.sFaceCoque1, interCC.sFaceCoque2)
124 >                End If
125 >            Catch
126 >                If interCC.DoitCouperCoque2 Then
127 >                    rayon = interCC.sFaceCoque1.GetEpaisseur / 2
128 >                    Dim sweep As sldworks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
129 >                    interCC.DecouperCoque(interCC.sFaceCoque2, sweep)
130 >                    If Intersections.MettreMiniPoutresSurFaceInternes Then interCC.MarquerFacesInternes(interCC.sFaceCoque1, interCC.sFaceCoque2)
131 >                End If
132  
133 <                ' reste à retrouver les faces internes.
134 <                interCC.MarquerFacesInternes(IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2, interCC.sFaceCoque1), IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque1, interCC.sFaceCoque2))
135 <            Next
133 >                If interCC.DoitCouperCoque1 Then
134 >                    rayon = interCC.sFaceCoque2.GetEpaisseur / 2
135 >                    Dim sweep As sldworks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
136 >                    interCC.DecouperCoque(interCC.sFaceCoque1, sweep)
137 >                    If Intersections.MettreMiniPoutresSurFaceInternes Then interCC.MarquerFacesInternes(interCC.sFaceCoque2, interCC.sFaceCoque1)
138 >                End If
139 >
140 >
141 >            End Try
142 >
143 >
144 >
145 >
146 >
147 >            If interCC.FaceAPlat Then
148 >                interCC.CoupeAPlat()
149 >            End If
150 >
151 >            ' reste à retrouver les faces internes.
152 >            'interCC.MarquerFacesInternes(IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2, interCC.sFaceCoque1), IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque1, interCC.sFaceCoque2))
153          Next
154  
155  
156      End Sub
157  
158 +    'Private Sub DecouperCoqueCoque()
159 +    '    Dim rayon As Double
160 +
161 +
162 +    '    For Each Coque As SlyFaceCoque In Commun.lst_FaceCoque
163 +    '        For Each interCC As InterCoqueCoque In Coque.lst_InterCoqueCoque
164 +    '            rayon = IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2.GetEpaisseur, interCC.sFaceCoque1.GetEpaisseur)
165 +    '            Dim sweep As SldWorks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
166 +    '            interCC.DecouperCoque(Coque, sweep)
167 +
168 +    '            ' reste à retrouver les faces internes.
169 +    '            interCC.MarquerFacesInternes(IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2, interCC.sFaceCoque1), IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque1, interCC.sFaceCoque2))
170 +    '        Next
171 +    '    Next
172 +
173 +
174 +    'End Sub
175 +
176 +
177 +
178      ''' <summary>
179      '''  sub qui créé une instance de la classe interCoqueCoque s'il y a une intersection de ce type
180      ''' </summary>
# Line 126 | Line 192 | Module Intersections
192                  If DetectFaceFace(Coque2.SwFace, Coque1.SwFace, True, sketch) Then
193                      ' création de l'instance de interFace-face entre coque et coque
194  
195 <                    interCC = New InterCoqueCoque
130 <                    interCC.sFaceCoque1 = Coque1
131 <                    interCC.sFaceCoque2 = Coque2
195 >                    interCC = New InterCoqueCoque(Coque1, Coque2)
196                      interCC.FaceDeSection = False
197                      interCC.sketch = sketch
198 +                    interCC.determineType()
199 +                    lst_InterCoqueCoque.Add(interCC)
200 +
201  
202 <                    Coque1.lst_InterCoqueCoque.Add(interCC)
203 <                    Coque2.lst_InterCoqueCoque.Add(interCC)
202 >                    'Coque1.lst_InterCoqueCoque.Add(interCC)
203 >                    'Coque2.lst_InterCoqueCoque.Add(interCC)
204                  End If
205  
206              Next j
# Line 219 | Line 286 | Module Intersections
286          DefAttrRCP1.AddParameter("D5", 0, 0, 0)
287          DefAttrRCP1.AddParameter("D6", 0, 0, 0)
288          DefAttrRCP1.AddParameter("Flag", 0, 0, 0)
222
289          retval = DefAttrRCP1.Register()
290          If retval = False Then MsgBox("Enregistrement raté pour le RCPoutre")
291  
# Line 231 | Line 297 | Module Intersections
297          If retval = False Then MsgBox("Enregistrement raté pour le RCCoque")
298  
299          DefAttrFaceInterne = swApp.DefineAttribute("FaceInterne")
300 <        DefAttrFaceInterne.AddParameter("FI", 0, 0, 0)  ' la présence de l'attribut est suffisante.
300 >        DefAttrFaceInterne.AddParameter("FI", 0, 0, 0)  ' la taille des éléments
301 >        DefAttrFaceInterne.AddParameter("Po", 0, 0, 0)  ' =0 si poutre, =1 si coque
302          retval = DefAttrFaceInterne.Register()
303          If retval = False Then MsgBox("Enregistrement raté pour le FaceInterne")
304  
# Line 247 | Line 314 | Module Intersections
314          retval = DefAttrIgnorer.Register()
315          If retval = False Then MsgBox("Enregistrement raté pour le Ignorer")
316  
317 +
318          nouveau = True
319  
320      End Sub
# Line 539 | Line 607 | Module Intersections
607  
608                              If sPoutre.Evaluer(T1, PointTest) Then
609                                  ' la valeur de T appartient à la poutre, maintenant on vérifie s'il appartient aussi à la coque
610 <                                If Distance(sCoque.lst_Faces.Item(1), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
610 >                                If Distance(sCoque.lst_Faces.Item(0), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
611                                      ' on est dans la coque.
612                                      If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
613                                  End If
614                              End If
615  
616                              If sPoutre.Evaluer(T2, PointTest) Then
617 <                                effacer = Distance(sCoque.lst_Faces.Item(1), PointTest(0), PointTest(1), PointTest(2))
618 <                                If Distance(sCoque.lst_Faces.Item(1), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
617 >                                effacer = Distance(sCoque.lst_Faces.Item(0), PointTest(0), PointTest(1), PointTest(2))
618 >                                If Distance(sCoque.lst_Faces.Item(0), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
619                                      If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
620                                  End If
621                              End If
# Line 631 | Line 699 | Module Intersections
699      ''' <remarks></remarks>
700      Private Sub DecouperPoutreVolume()
701          ' #2 on procède au découpage de la face
702 <        Dim sVol As SlyFaceVolume
702 >        Dim sFaceVol As SlyFaceVolume
703  
704 <        For Each sVol In lst_FaceVolume
705 <            If sVol.lst_InterPoutre.Count > 0 Then
706 <                sVol.decouper()
704 >        For Each sFaceVol In lst_FaceVolume
705 >            If sFaceVol.lst_InterPoutre.Count > 0 Then
706 >                sFaceVol.decouper()
707  
708                  ' on met-a-jour l'attribut des conditions aux limites
709 <                Dim attr As SldWorks.Attribute
710 <                Dim swent As SldWorks.Entity
709 >                Dim attr As sldworks.Attribute
710 >                Dim swent As sldworks.Entity
711                  Dim nom3 As String = Nothing
712 <                Dim p As SldWorks.Parameter
713 <                If Not sVol.AttributCL Is Nothing Then
714 <                    nom3 = "CL_" & sVol.nom
715 <                    swent = sVol.SwFace
712 >                Dim p As sldworks.Parameter
713 >                If Not sFaceVol.AttributCL Is Nothing Then
714 >                    nom3 = "CL_" & sFaceVol.nom
715 >                    swent = sFaceVol.SwFace
716                      attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
717  
718 <                    If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, sVol.SwFace, nom3, 0, 0)
718 >                    If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, sFaceVol.SwFace, nom3, 0, 0)
719                      p = attr.GetParameter("CL")
720 <                    p.SetStringValue(sVol.condition)
720 >                    p.SetStringValue(sFaceVol.condition)
721  
722                  End If
723                  GererDossiers("Conditions Aux Limites", nom3)
# Line 682 | Line 750 | Module Intersections
750          ' 1 - Spotter la ou les faces en question
751          xyz = sPoutre.GetStartPoint
752          xyz2 = sPoutre.GetEndPoint
753 +
754          For Each sVol In Commun.lst_FaceVolume
755              If Intersections.DetectSurfaceArete(sPoutre.swArete, sVol.SwFace, Nothing) Then
756                  swModel.ClearSelection2(True)
757                  sVol.Selectionner()
758                  section = swExt.GetSectionProperties2(sVol.SwFace) : proprietes = section
759                  swModel.ClearSelection2(True)
760 <                ' la fontion getsectionproperties renvoie des valeurs dont la précision est très douteuse...
760 >                ' la fonction getsectionproperties renvoie des valeurs dont la précision est très douteuse...
761                  ' on met alors une beaucoup plus grosse tolérance...
762 <                If Math.Abs(xyz(0) - proprietes(2)) < 0.0001 And Math.Abs(xyz(1) - proprietes(3)) < 0.0001 And Math.Abs(xyz(2) - proprietes(4)) < 0.0001 Then Face1 = sVol : prop1 = proprietes
763 <                If Math.Abs(xyz2(0) - proprietes(2)) < 0.0001 And Math.Abs(xyz2(1) - proprietes(3)) < 0.0001 And Math.Abs(xyz2(2) - proprietes(4)) < 0.0001 Then Face2 = sVol : prop2 = proprietes
762 >                If Math.Abs(xyz(0) - proprietes(2)) < 0.0001 And Math.Abs(xyz(1) - proprietes(3)) < 0.0001 And Math.Abs(xyz(2) - proprietes(4)) < 0.0001 Then
763 >                    Face1 = sVol : prop1 = proprietes
764 >                ElseIf Math.Abs(xyz2(0) - proprietes(2)) < 0.0001 And Math.Abs(xyz2(1) - proprietes(3)) < 0.0001 And Math.Abs(xyz2(2) - proprietes(4)) < 0.0001 Then
765 >                    Face2 = sVol : prop2 = proprietes
766 >                Else
767 >                    ' on a une intersection où la poutre touche à une face «guide» et une autre partie touche à une face normale
768 >                    ' la face est automatiquement une face de volume.  Si c'est une coque, elle est traitée ailleurs.
769 >
770 >                    'Dim interNormale As InterPoutreVolume
771 >                    'Dim point1 As Object = Nothing
772 >                    'swModel.ClosestDistance(sPoutre.swArete, sVol.SwFace, point1, Nothing)
773 >                    'Dim xyzNormale() As Double = point1
774 >                    'interNormale = sVol.AjouterInterPoutre(sPoutre, xyzNormale, 6) ' y'a des cas où ça pourrait ne pas être 1...
775 >                    'sPoutre.lst_InterCoque.Add(interNormale)
776 >
777 >                End If
778 >
779              End If
780          Next
781  
# Line 701 | Line 785 | Module Intersections
785              Dim e As New SuperArete(sPoutre.swArete, True)
786              e.Colorer(3, 1, 0, 0)
787              sPoutre.Selectionner()
788 +            Err.Raise(520, "Gestion_Face_De_Section", "Une poutre ne peut être traitée car elle n'a pas été correctement définie.")
789              Exit Sub
790          End If
791  
# Line 721 | Line 806 | Module Intersections
806          ' 2.2 le centroide est au point d'intersection
807          ' déjà fait
808          ' 2.3 la face est plane
809 +        Dim prop() As Double = Nothing
810 +
811          If Face1 IsNot Nothing Then
812 +            prop = prop1
813              If Not (Face1.estPlan Xor Face1.estFauxPlan(prop1(2), prop1(3), prop1(4))) Then
814                  MsgBox("La face 1 n'est pas plane!")
815                  Err.Raise(513, , "Ne peut pas prendre une face non plane comme source de la section de la poutre")
816              End If
817          End If
818          If Face2 IsNot Nothing Then
819 <            If Not (Face2.estPlan Xor Face2.estFauxPlan(prop1(2), prop1(3), prop1(4))) Then
819 >            prop = prop2
820 >            If Not (Face2.estPlan Xor Face2.estFauxPlan(prop2(2), prop2(3), prop2(4))) Then
821                  MsgBox("La face 2 n'est pas plane!")
822                  Err.Raise(513, , "Ne peut pas prendre une face non plane comme source de la section de la poutre")
823              End If
# Line 762 | Line 851 | Module Intersections
851          ' 3 - trouver l'inertie et l'aire, placer le point 3 de façon cohérente, updater l'attribut.
852          Dim Nom3 As String
853  
854 <        Commun.MettreUnPoint(prop1(2) + prop1(18) / 1000, prop1(3) + prop1(19) / 1000, prop1(4) + prop1(20) / 1000, True)
855 <        Nom3 = RealConstant.RCCode.Creation3iemePoint(1)
856 <        sPoutre.SetAttributsDePoutre(False, Nom3, , , prop1(13), prop1(14), prop1(1), , , , , , , 1)
854 >        Commun.MettreUnPoint(prop(2) + prop(18) / 1000, prop(3) + prop(19) / 1000, prop(4) + prop(20) / 1000, True)
855 >        Dim selmgr As sldworks.SelectionMgr = swModel.SelectionManager
856 >        Nom3 = RealConstant.RCCode.Creation3iemePoint(selmgr.GetSelectedObject(1))
857 >        sPoutre.SetAttributsDePoutre(False, Nom3, , , prop(13), prop(14), prop(1), , , , , , , 1)
858  
859          ' 4 créer une nouvelle instance de la classe interFacePoutre de tipe 5
860          Dim inter As New InterPoutreVolume
# Line 796 | Line 886 | Module Intersections
886          Dim i As Integer
887          Dim premier2 As Boolean
888          Dim sVol As SlyFaceVolume
889 +        Dim SurSurface As Boolean = False
890  
891          For Each sVol In lst_FaceVolume
892  
802
893              ' on cherche entre la coque et la poutre
894 <
895 <
806 <
807 <            If DetectFaceArete(sPoutre.swArete, sVol, xyz) Then
808 <
894 >            SurSurface = False
895 >            If DetectFaceArete(sPoutre.swArete, sVol, xyz, SurSurface) Then
896                  For i = 0 To UBound(xyz) - 1 Step 3
897                      ' trouver le tipe d'intersection...
898  
# Line 827 | Line 914 | Module Intersections
914                          T1 = T + 15 * Epsilon
915                          T2 = T - 15 * Epsilon
916  
830                        Dim effacer As Double
917  
918                          If sPoutre.Evaluer(T1, PointTest) Then
919                              ' la valeur de T appartient à la poutre, maintenant on vérifie s'il appartient aussi à la coque
# Line 838 | Line 924 | Module Intersections
924                          End If
925  
926                          If sPoutre.Evaluer(T2, PointTest) Then
927 <                            effacer = Distance(sVol.SwFace, PointTest(0), PointTest(1), PointTest(2))
927 >
928                              If Distance(sVol.SwFace, PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
929                                  If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
930                              End If
# Line 857 | Line 943 | Module Intersections
943  
944                  Next i ' autre point d'intersection
945  
946 +            ElseIf SurSurface = True Then
947 +                ' Si les 2 points de la courbe touchent à la surface alors  coupe-long
948 +                If Commun.Distance(sVol.SwFace, sPoutre.GetStartPoint()) < Epsilon AndAlso Commun.Distance(sVol.SwFace, sPoutre.GetEndPoint()) < Epsilon Then
949 +                    inter = sVol.AjouterInterPoutre(sPoutre, xyz, 2)
950 +                    sPoutre.lst_InterCoque.Add(inter)
951 +                End If
952              End If
953              premier2 = False ' reset
954  
# Line 1084 | Line 1176 | Module Intersections
1176  
1177  
1178  
1179 <    Private Function DetectFaceArete(ByRef swArete As SldWorks.Edge, ByRef Slyface As SlyFaceVolume, ByRef xyz() As Double) As Boolean
1180 <        Dim swface As SldWorks.Face2
1181 <        Dim surarete As Boolean
1179 >    Private Function DetectFaceArete(ByRef swArete As sldworks.Edge, ByRef Slyface As SlyFaceVolume, ByRef xyz() As Double, Optional ByRef SurSurface As Boolean = False) As Boolean
1180 >        Dim swface As sldworks.Face2
1181 >
1182          For Each swface In Slyface.lst_Faces
1183              If DetectFaceArete(swArete, swface, xyz) Then
1184                  Dim vEdges As Object
1185 <                Dim Arete As SldWorks.Edge
1185 >                Dim Arete As sldworks.Edge
1186                  Dim inu() As Double = Nothing
1187  
1188                  vEdges = swface.GetEdges
# Line 1098 | Line 1190 | Module Intersections
1190                  For Each Arete In vEdges
1191                      If DetectAreteArete(Arete, swArete, inu) Then
1192                          ' on a un type d'intersection entre une face et une arète...
1193 <                        Dim swSurf As SldWorks.Surface
1193 >                        Dim swSurf As sldworks.Surface
1194                          Dim retval As Object
1195                          Dim v(2) As Double
1196                          Dim u(2) As Double
# Line 1112 | Line 1204 | Module Intersections
1204                          retval = swArete.Evaluate(retval(0))
1205                          u(0) = retval(3) : u(1) = retval(4) : u(2) = retval(5)
1206                          angle = Outils_Math.Angle2Vecteurs(u, v)
1207 <                        MsgBox(angle * 180 / Pi & "<-- angle sens --> " & swface.FaceInSurfaceSense)
1207 >                        'MsgBox(angle * 180 / Pi & "<-- angle sens --> " & swface.FaceInSurfaceSense & vbCr & "Aire = " & Slyface.Aire)
1208  
1209 <                        If ((angle < (Pi / 2)) Xor swface.FaceInSurfaceSense()) Then
1210 <                            Return True
1209 >
1210 >                        'Si l'angle entre la normale de la face et la normale de la courbe est de 0
1211 >                        ' ou de pi/2 alors on a une SurSurface
1212 >                        If Math.Abs(angle - Pi / 2) < 100 * Epsilon Or Math.Abs(angle) < 100 * Epsilon Then
1213 >                            SurSurface = True
1214                          Else
1215 <                            surarete = True
1215 >                            Return True
1216                          End If
1217 +
1218 +                        'If ((angle < (Pi / 2)) Xor swface.FaceInSurfaceSense()) Then
1219 +                        '    Return True
1220 +                        'Else
1221 +                        '    SurSurface = True
1222 +                        'End If
1223                      End If
1224                  Next
1225  
1226  
1227 <                If Not surarete Then Return True Else Return False
1227 >                If Not SurSurface Then Return True Else Return False
1228              End If
1229          Next
1230      End Function
# Line 1382 | Line 1483 | Module Intersections
1483          Dim a1 As Integer
1484          Dim a2 As Integer
1485  
1486 +        Try
1487 +            For a1 = 0 To lst_AretePoutre.Count - 1
1488 +                SlyArete1 = lst_AretePoutre.Item(a1)
1489 +                swArete1 = SlyArete1.swArete
1490 +
1491 +                If Not a1 = lst_AretePoutre.Count - 1 Then
1492 +                    For a2 = a1 + 1 To lst_AretePoutre.Count - 1
1493 +                        SlyArete2 = lst_AretePoutre.Item(a2)
1494 +                        swArete2 = SlyArete2.swArete
1495 +
1496 +                        If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1497 +                            For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1498 +
1499 +                                Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1500 +                                    Case 1 ' la première courbe est coupée
1501 +                                        pt = New InterPoutrePoutre
1502 +                                        pt.Arete = swArete1
1503 +                                        pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1504 +                                        SlyArete1.AjouterPointAPAP(pt)
1505 +                                        pt = Nothing
1506 +                                    Case 2 ' la seconde courbe est coupée
1507 +                                        pt = New InterPoutrePoutre
1508 +                                        pt.Arete = swArete2
1509 +                                        pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1510 +                                        SlyArete2.AjouterPointAPAP(pt)
1511 +                                        pt = Nothing
1512 +                                    Case 3 ' les doux poutres sont coupées
1513 +                                        pt = New InterPoutrePoutre
1514 +                                        pt.Arete = swArete1
1515 +                                        pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1516 +                                        SlyArete1.AjouterPointAPAP(pt)
1517 +                                        pt = Nothing
1518 +                                        pt = New InterPoutrePoutre
1519 +                                        pt.Arete = swArete2
1520 +                                        pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1521 +                                        SlyArete2.AjouterPointAPAP(pt)
1522 +                                        pt = Nothing
1523 +                                End Select
1524 +                            Next i
1525 +                        End If
1526  
1527 <        For a1 = 0 To lst_AretePoutre.Count - 2
1387 <            SlyArete1 = lst_AretePoutre.Item(a1)
1388 <            swArete1 = SlyArete1.swArete
1389 <
1390 <            For a2 = a1 + 1 To lst_AretePoutre.Count - 1
1391 <                SlyArete2 = lst_AretePoutre.Item(a2)
1392 <                swArete2 = SlyArete2.swArete
1393 <
1394 <                If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1395 <                    For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1396 <
1397 <                        Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1398 <                            Case 1 ' la première courbe est coupée
1399 <                                pt = New InterPoutrePoutre
1400 <                                pt.Arete = swArete1
1401 <                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1402 <                                SlyArete1.AjouterPointAPAP(pt)
1403 <                                pt = Nothing
1404 <                            Case 2 ' la seconde courbe est coupée
1405 <                                pt = New InterPoutrePoutre
1406 <                                pt.Arete = swArete2
1407 <                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1408 <                                SlyArete2.AjouterPointAPAP(pt)
1409 <                                pt = Nothing
1410 <                            Case 3 ' les doux poutres sont coupées
1411 <                                pt = New InterPoutrePoutre
1412 <                                pt.Arete = swArete1
1413 <                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1414 <                                SlyArete1.AjouterPointAPAP(pt)
1415 <                                pt = Nothing
1416 <                                pt = New InterPoutrePoutre
1417 <                                pt.Arete = swArete2
1418 <                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1419 <                                SlyArete2.AjouterPointAPAP(pt)
1420 <                                pt = Nothing
1421 <                        End Select
1422 <                    Next i
1527 >                    Next a2
1528                  End If
1529  
1530 <            Next a2
1531 <
1532 <            Dim SlyArete3 As SlyAreteCoque
1533 <            For a2 = 0 To lst_AreteCoque.Count - 1
1534 <                SlyArete3 = lst_AreteCoque.Item(a2)
1535 <                swArete2 = SlyArete3.swArete
1530 >                Dim SlyArete3 As SlyAreteCoque
1531 >                For a2 = 0 To lst_AreteCoque.Count - 1
1532 >                    SlyArete3 = lst_AreteCoque.Item(a2)
1533 >                    swArete2 = SlyArete3.swArete
1534 >
1535 >                    If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1536 >                        For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1537 >
1538 >                            Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1539 >                                Case 1 ' la première courbe est coupée
1540 >                                    pt = New InterPoutrePoutre
1541 >                                    pt.Arete = swArete1
1542 >                                    pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1543 >                                    SlyArete1.AjouterPointAPAP(pt)
1544 >                                    pt = Nothing
1545 >                                    ' seul la coque est coupée, elle sera découpée anyway.
1546 >                                Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1547 >                                    pt = New InterPoutrePoutre
1548 >                                    pt.Arete = swArete1
1549 >                                    pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1550 >                                    SlyArete1.AjouterPointAPAP(pt)
1551 >                                    pt = Nothing
1552 >                            End Select
1553 >                        Next i
1554 >                    End If
1555 >                Next a2
1556  
1557 <                If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1558 <                    For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1557 >                Dim slyarete4 As SlyAreteVol
1558 >                For a2 = 0 To lst_AreteVolume.Count - 1
1559 >                    slyarete4 = lst_AreteVolume.Item(a2)
1560 >                    swArete2 = slyarete4.swArete
1561 >
1562 >                    If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1563 >                        For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1564 >
1565 >                            Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1566 >                                Case 1 ' la première courbe est coupée
1567 >                                    pt = New InterPoutrePoutre
1568 >                                    pt.Arete = swArete1
1569 >                                    pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1570 >                                    SlyArete1.AjouterPointAPAP(pt)
1571 >                                    pt = Nothing
1572 >                                Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1573 >                                    pt = New InterPoutrePoutre
1574 >                                    pt.Arete = swArete1
1575 >                                    pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1576 >                                    SlyArete1.AjouterPointAPAP(pt)
1577 >                                    pt = Nothing
1578 >                            End Select
1579 >                        Next i
1580 >                    End If
1581 >                Next a2
1582  
1435                        Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1436                            Case 1 ' la première courbe est coupée
1437                                pt = New InterPoutrePoutre
1438                                pt.Arete = swArete1
1439                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1440                                SlyArete1.AjouterPointAPAP(pt)
1441                                pt = Nothing
1442                                ' seul la coque est coupée, elle sera découpée anyway.
1443                            Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1444                                pt = New InterPoutrePoutre
1445                                pt.Arete = swArete1
1446                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1447                                SlyArete1.AjouterPointAPAP(pt)
1448                                pt = Nothing
1449                        End Select
1450                    Next i
1451                End If
1452            Next a2
1583  
1454            Dim slyarete4 As SlyAreteVol
1455            For a2 = 0 To lst_AreteVolume.Count - 1
1456                slyarete4 = lst_AreteVolume.Item(a2)
1457                swArete2 = slyarete4.swArete
1584  
1585 <                If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1586 <                    For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1461 <
1462 <                        Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1463 <                            Case 1 ' la première courbe est coupée
1464 <                                pt = New InterPoutrePoutre
1465 <                                pt.Arete = swArete1
1466 <                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1467 <                                SlyArete1.AjouterPointAPAP(pt)
1468 <                                pt = Nothing
1469 <                            Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1470 <                                pt = New InterPoutrePoutre
1471 <                                pt.Arete = swArete1
1472 <                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1473 <                                SlyArete1.AjouterPointAPAP(pt)
1474 <                                pt = Nothing
1475 <                        End Select
1476 <                    Next i
1477 <                End If
1478 <            Next a2
1585 >            Next a1
1586 >            pt = Nothing
1587  
1588 +        Catch
1589 +            MsgBox(" La première boucle n'a pas marchée")
1590 +        End Try
1591  
1592  
1593 <        Next a1
1594 <        pt = Nothing
1593 >        Dim count As Long = 0, count2 As Long = 0
1594 >        Try
1595  
1596 +            'toutes les poutres ont des points où elles doivent être coupées
1597 +            ' il suffit de couper.
1598 +            ' en réalité on suppress et on créé 2 ou plus courbes par dessus.
1599 +            Dim attr As sldworks.Attribute
1600 +            Dim swEnt As sldworks.Entity
1601 +
1602 +            For Each SlyArete1 In lst_AretePoutre
1603 +                If SlyArete1.lst_PtsInterAPAP.Count > 0 Then ' on coupe
1604 +                    '1 - ordonner les points, de Tmin à Tmax et inclure les 2 extrémités de la poutre
1605 +
1606 +                    count += 1
1607 +                    ' si c'est une droite
1608 +                    If SlyArete1.IsLine Then
1609 +                        Dim Pts(,) As Double
1610 +                        Dim swSketch As sldworks.Sketch
1611 +                        ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1612 +
1613 +                        SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1614 +                        Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1615 +
1616 +                        For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1617 +                            Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1618 +                            Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1619 +                            Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1620 +                            Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1621 +                        Next i
1622 +
1623 +                        Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1624 +                        SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1625 +                        Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1626 +
1627 +                        ' faut ordonner les points selon T...
1628 +                        Dim j As Integer
1629 +                        Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1630 +                        For i = 0 To max - 2
1631 +                            For j = 0 To max - i - 1
1632 +                                If Pts(3, j) > Pts(3, j + 1) Then
1633 +                                    T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1634 +                                    Pts(0, j) = Pts(0, j + 1) : Pts(1, j) = Pts(1, j + 1) : Pts(2, j) = Pts(2, j + 1) : Pts(3, j) = Pts(3, j + 1)
1635 +                                    Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1636 +                                End If
1637 +                            Next j
1638 +                        Next i
1639  
1640  
1641 <        'toutes les poutres ont des points où elles doivent être coupées
1642 <        ' il suffit de couper.
1643 <        ' en réalité on suppress et on créé 2 ou plus courbes par dessus.
1644 <        Dim attr As SldWorks.Attribute
1645 <        Dim swEnt As SldWorks.Entity
1646 <
1647 <        For Each SlyArete1 In lst_AretePoutre
1648 <            If SlyArete1.lst_PtsInterAPAP.Count > 0 Then ' on coupe
1649 <                '1 - ordonner les points, de Tmin à Tmax et inclure les 2 extrémités de la poutre
1650 <
1651 <
1652 <                ' si c'est une droite
1653 <                If SlyArete1.IsLine Then
1654 <                    Dim Pts(,) As Double
1655 <                    Dim swSketch As SldWorks.Sketch
1656 <                    ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1657 <
1658 <                    SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1659 <                    Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1660 <
1661 <                    For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1662 <                        Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1663 <                        Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1664 <                        Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1665 <                        Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1666 <                    Next i
1641 >                        For i = 0 To UBound(Pts, 2) - 1
1642 >                            swModel.Insert3DSketch2(False)
1643 >                            swModel.CreateLine2(Pts(0, i), Pts(1, i), Pts(2, i), Pts(0, i + 1), Pts(1, i + 1), Pts(2, i + 1)) ' et pour chaque segment
1644 >                            swSketch = swModel.GetActiveSketch2
1645 >                            swModel.Insert3DSketch2(False)
1646 >
1647 >                            swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1648 >                            swModel.InsertCompositeCurve()
1649 >                            Try
1650 >                                count2 += 1
1651 >                                UpdateAttributs(SlyArete1, i) 'ajouter les attributs de la vieille poutre sur la nouvelle
1652 >                            Catch
1653 >                                MsgBox("UpdateAttribut n'a pas marché au compte # " & count2)
1654 >                            End Try
1655 >                        Next i
1656 >
1657 >
1658 >                    Else ' If SlyArete1.IsCircle Then  ' si c'est un cercle
1659 >
1660 >                        Dim Pts(,) As Double
1661 >                        Dim swSketch As sldworks.Sketch
1662 >                        ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1663 >
1664 >                        SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1665 >                        Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1666 >
1667 >                        For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1668 >                            Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1669 >                            Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1670 >                            Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1671 >                            Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1672 >                        Next i
1673 >
1674 >                        Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1675 >                        SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1676 >                        Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1677 >
1678 >                        ' faut ordonner les points selon T...
1679 >                        Dim j As Integer
1680 >                        Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1681 >                        For i = 0 To max - 2
1682 >                            For j = 0 To max - i - 1
1683 >                                If Pts(3, j) > Pts(3, j + 1) Then
1684 >                                    T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1685 >                                    Pts(0, j) = Pts(0, j + 1) : Pts(1, j) = Pts(1, j + 1) : Pts(2, j) = Pts(2, j + 1) : Pts(3, j) = Pts(3, j + 1)
1686 >                                    Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1687 >                                End If
1688 >                            Next j
1689 >                        Next i
1690  
1691 <                    Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1692 <                    SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1693 <                    Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1694 <
1695 <                    ' faut ordonner les points selon T...
1696 <                    Dim j As Integer
1697 <                    Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1698 <                    For i = 0 To max - 2
1699 <                        For j = 0 To max - i - 1
1700 <                            If Pts(3, j) > Pts(3, j + 1) Then
1701 <                                T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1702 <                                Pts(0, j) = Pts(0, j + 1) : Pts(1, j) = Pts(1, j + 1) : Pts(2, j) = Pts(2, j + 1) : Pts(3, j) = Pts(3, j + 1)
1703 <                                Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1691 >                        Dim skSeg As sldworks.SketchSegment
1692 >                        Dim x As Double, y As Double, z As Double
1693 >                        Dim vretval As Object
1694 >                        Dim useEdge As sldworks.SketchSegment
1695 >                        Dim m As Integer
1696 >
1697 >
1698 >                        For i = 0 To UBound(Pts, 2) - 1
1699 >                            swModel.Insert3DSketch2(False)
1700 >                            ' sélectionner la edge originale
1701 >                            swEnt = SlyArete1.swArete
1702 >                            swEnt.Select4(False, Nothing)
1703 >                            swModel.SketchUseEdge2(False)
1704 >                            swSketch = swModel.GetActiveSketch2()
1705 >
1706 >                            ' on créé 2 lignes de construction et on pick de chaque coté... mais on ne le fait pas si on est au premier ou au dernier segment. là on fait juste un pick.
1707 >                            If i <> 0 Then ' premier pick, élimine ce qui est avant.
1708 >                                skSeg = swModel.CreateLine2(Pts(0, i), Pts(1, i), Pts(2, i), 0.01, 0.01, 0.01)    'pts(0, i - 1) + 10000000 * Epsilon, pts(1, i - 1) + 100000 * Epsilon, pts(2, i - 1) + 100000 * Epsilon)
1709 >                                skSeg.ConstructionGeometry = True ' ligne de construction
1710 >                                swModel.ClearSelection2(True)
1711 >                                ' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1712 >                                SlyArete1.Evaluer((Pts(3, i - 1) + Pts(3, i)) / 2, x, y, z)
1713 >                                vretval = swSketch.GetSketchSegments
1714 >                                useEdge = vretval(0) : m = 0
1715 >                                Do Until useEdge.ConstructionGeometry = False
1716 >                                    m += 1
1717 >                                    useEdge = vretval(m)
1718 >                                Loop
1719 >                                useEdge.Select4(False, Nothing)
1720 >                                swModel.SketchTrim(1, 0, x, y) ' option = 1 pour trim, selEnd est pas utilisé ?, puis un point x et Y pour sélectionner.  et y'a pas de Z????? c'est un sketch3D!!!!!
1721 >                                skSeg = swModel.CreateLine2(0, 0, 0, x, y, 0)
1722 >                                skSeg.ConstructionGeometry = True
1723                              End If
1528                        Next j
1529                    Next i
1724  
1725 <
1726 <                    For i = 0 To UBound(Pts, 2) - 1
1727 <                        swModel.Insert3DSketch2(False)
1728 <                        swModel.CreateLine2(Pts(0, i), Pts(1, i), Pts(2, i), Pts(0, i + 1), Pts(1, i + 1), Pts(2, i + 1)) ' et pour chaque segment
1729 <                        swSketch = swModel.GetActiveSketch2
1730 <                        swModel.Insert3DSketch2(False)
1731 <
1732 <                        swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1733 <                        swModel.InsertCompositeCurve()
1734 <
1735 <                        UpdateAttributs(SlyArete1, i) 'ajouter les attributs de la vieille poutre sur la nouvelle
1736 <                    Next i
1737 <
1738 <
1739 <                Else ' If SlyArete1.IsCircle Then  ' si c'est un cercle
1740 <
1741 <                    Dim Pts(,) As Double
1742 <                    Dim swSketch As SldWorks.Sketch
1549 <                    ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1550 <
1551 <                    SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1552 <                    Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1553 <
1554 <                    For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1555 <                        Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1556 <                        Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1557 <                        Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1558 <                        Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1559 <                    Next i
1560 <
1561 <                    Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1562 <                    SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1563 <                    Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1564 <
1565 <                    ' faut ordonner les points selon T...
1566 <                    Dim j As Integer
1567 <                    Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1568 <                    For i = 0 To max - 2
1569 <                        For j = 0 To max - i - 1
1570 <                            If Pts(3, j) > Pts(3, j + 1) Then
1571 <                                T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1572 <                                Pts(0, j) = Pts(0, j + 1) : Pts(1, j) = Pts(1, j + 1) : Pts(2, j) = Pts(2, j + 1) : Pts(3, j) = Pts(3, j + 1)
1573 <                                Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1725 >                            If i <> UBound(Pts, 2) - 1 Then 'Second(pick)
1726 >                                skSeg = swModel.CreateLine2(Pts(0, i + 1), Pts(1, i + 1), Pts(2, i + 1), 0.05, 0, 0.01) 'pts(0, i + 1) + 10000000 * Epsilon, pts(1, i + 1) + 1000000 * Epsilon, pts(2, i + 1) + 100000 * Epsilon)
1727 >                                skSeg.ConstructionGeometry = True ' ligne de construction
1728 >                                swModel.ClearSelection2(True)
1729 >
1730 >                                ' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1731 >                                SlyArete1.Evaluer((Pts(3, i + 1) + Pts(3, i + 2)) / 2, x, y, z)
1732 >                                vretval = swSketch.GetSketchSegments
1733 >                                useEdge = vretval(0) : m = 0
1734 >                                Do Until useEdge.ConstructionGeometry = False
1735 >                                    m += 1
1736 >                                    useEdge = vretval(m)
1737 >                                Loop
1738 >
1739 >                                useEdge.Select4(False, Nothing)
1740 >                                swModel.SketchTrim(1, 0, x, y) ' option = 1 pour trim, selEnd est pas utilisé ?, puis un point x et Y pour sélectionner.  et y'a pas de Z????? c'est un sketch3D!!!!!
1741 >                                skSeg = swModel.CreateLine2(0, 0.02, 0, x, y, 0)
1742 >                                skSeg.ConstructionGeometry = True
1743                              End If
1575                        Next j
1576                    Next i
1577
1578                    Dim skSeg As SldWorks.SketchSegment
1579                    Dim x As Double, y As Double, z As Double
1580                    Dim vretval As Object
1581                    Dim useEdge As SldWorks.SketchSegment
1582                    Dim m As Integer
1583
1584
1585                    For i = 0 To UBound(Pts, 2) - 1
1586                        swModel.Insert3DSketch2(False)
1587                        ' sélectionner la edge originale
1588                        swEnt = SlyArete1.swArete
1589                        swEnt.Select4(False, Nothing)
1590                        swModel.SketchUseEdge2(False)
1591                        swSketch = swModel.GetActiveSketch2()
1592
1593                        ' on créé 2 lignes de construction et on pick de chaque coté... mais on ne le fait pas si on est au premier ou au dernier segment. là on fait juste un pick.
1594                        If i <> 0 Then ' premier pick, élimine ce qui est avant.
1595                            skSeg = swModel.CreateLine2(Pts(0, i), Pts(1, i), Pts(2, i), 0.01, 0.01, 0.01)    'pts(0, i - 1) + 10000000 * Epsilon, pts(1, i - 1) + 100000 * Epsilon, pts(2, i - 1) + 100000 * Epsilon)
1596                            skSeg.ConstructionGeometry = True ' ligne de construction
1597                            swModel.ClearSelection2(True)
1598                            ' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1599                            SlyArete1.Evaluer((Pts(3, i - 1) + Pts(3, i)) / 2, x, y, z)
1600                            vretval = swSketch.GetSketchSegments
1601                            useEdge = vretval(0) : m = 0
1602                            Do Until useEdge.ConstructionGeometry = False
1603                                m += 1
1604                                useEdge = vretval(m)
1605                            Loop
1606                            useEdge.Select4(False, Nothing)
1607                            swModel.SketchTrim(1, 0, x, y) ' option = 1 pour trim, selEnd est pas utilisé ?, puis un point x et Y pour sélectionner.  et y'a pas de Z????? c'est un sketch3D!!!!!
1608                            skSeg = swModel.CreateLine2(0, 0, 0, x, y, 0)
1609                            skSeg.ConstructionGeometry = True
1610                        End If
1744  
1745 <                        If i <> UBound(Pts, 2) - 1 Then 'Second(pick)
1746 <                            skSeg = swModel.CreateLine2(Pts(0, i + 1), Pts(1, i + 1), Pts(2, i + 1), 0.05, 0, 0.01) 'pts(0, i + 1) + 10000000 * Epsilon, pts(1, i + 1) + 1000000 * Epsilon, pts(2, i + 1) + 100000 * Epsilon)
1747 <                            skSeg.ConstructionGeometry = True ' ligne de construction
1748 <                            swModel.ClearSelection2(True)
1749 <
1617 <                            ' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1618 <                            SlyArete1.Evaluer((Pts(3, i + 1) + Pts(3, i + 2)) / 2, x, y, z)
1619 <                            vretval = swSketch.GetSketchSegments
1620 <                            useEdge = vretval(0) : m = 0
1621 <                            Do Until useEdge.ConstructionGeometry = False
1622 <                                m += 1
1623 <                                useEdge = vretval(m)
1624 <                            Loop
1625 <
1626 <                            useEdge.Select4(False, Nothing)
1627 <                            swModel.SketchTrim(1, 0, x, y) ' option = 1 pour trim, selEnd est pas utilisé ?, puis un point x et Y pour sélectionner.  et y'a pas de Z????? c'est un sketch3D!!!!!
1628 <                            skSeg = swModel.CreateLine2(0, 0.02, 0, x, y, 0)
1629 <                            skSeg.ConstructionGeometry = True
1630 <                        End If
1745 >                            swModel.Insert3DSketch2(False)
1746 >                            swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1747 >                            swModel.InsertCompositeCurve()
1748 >                            UpdateAttributs(SlyArete1, i)
1749 >                        Next i
1750  
1751 <                        swModel.Insert3DSketch2(False)
1633 <                        swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1634 <                        swModel.InsertCompositeCurve()
1635 <                        UpdateAttributs(SlyArete1, i)
1636 <                    Next i
1751 >                    End If
1752  
1638                End If
1753  
1754 <                ' tagger la vieille poutre pour ne pas la reprendre dans magic
1641 <                'Pour ça on ajoute un attribut pour ignorer...
1642 <                Dim nom As String
1643 <                Dim no As Integer
1644 <                Dim arete As SldWorks.Edge
1645 <
1646 <                arete = SlyArete1.swArete
1647 <                swEnt = arete
1648 <                nom = "Ignorer" & SlyArete1.nom & "_" & CStr(no)
1649 <                attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1650 <                'attr = DefAttrRCP1.CreateInstance5(swModel, arete, nom, 0, 2) ' une deuxième instance du RCPoutre...
1651 <                If attr Is Nothing Then
1652 <                    Commun.ColorerAretes()
1653 <                    swEnt = SlyArete1.swArete
1654 <                    attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1655 <                End If
1754 >                    ' on met un attribut pour ignorer l'arète.  Les sommets devraient donc aussi être ignorés.
1755  
1756 <                Dim p As SldWorks.Parameter
1658 <                p = attr.GetParameter("D1")
1659 <                p.SetDoubleValue(-9)
1660 <                p = attr.GetParameter("D2")
1661 <                p.SetDoubleValue(-9)
1662 <                p = attr.GetParameter("D3")
1663 <                p.SetDoubleValue(-9)
1664 <                p = attr.GetParameter("D4")
1665 <                p.SetDoubleValue(-9)
1756 >                    SlyArete1.MettreAttributIgnorer()
1757  
1758 <                If attr Is Nothing Then MsgBox("Pas marché")
1758 >                    'Dim nom As String
1759 >                    'Dim no As Integer
1760 >                    'Dim arete As sldworks.Edge
1761 >                    'arete = SlyArete1.swArete
1762 >                    'swEnt = arete
1763 >                    'nom = "Ignorer" & SlyArete1.nom & "_" & CStr(no)
1764 >                    'attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1765 >                    ''attr = DefAttrRCP1.CreateInstance5(swModel, arete, nom, 0, 2) ' une deuxième instance du RCPoutre...
1766 >                    'If attr Is Nothing Then
1767 >                    '    Commun.ColorerAretes()
1768 >                    '    swEnt = SlyArete1.swArete
1769 >                    '    attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1770 >                    'End If
1771 >
1772 >                    'Dim p As sldworks.Parameter
1773 >                    'p = attr.GetParameter("D1")
1774 >                    'p.SetDoubleValue(-9)
1775 >                    'p = attr.GetParameter("D2")
1776 >                    'p.SetDoubleValue(-9)
1777 >                    'p = attr.GetParameter("D3")
1778 >                    'p.SetDoubleValue(-9)
1779 >                    'p = attr.GetParameter("D4")
1780 >                    'p.SetDoubleValue(-9)
1781  
1782 +                    'If attr Is Nothing Then MsgBox("Pas marché")
1783  
1670            End If
1671        Next SlyArete1
1784  
1785 +                End If
1786 +            Next SlyArete1
1787 +        Catch
1788 +            MsgBox("La seconde boucle n'a pas marchée  Compte: " & count)
1789 +        End Try
1790  
1791      End Sub
1792  
1793  
1794 <    Private Sub UpdateAttributs(ByRef slyarete1 As SlyAretePoutre, ByRef i As Integer)
1795 <        Dim newArete As SldWorks.Edge
1796 <        Dim refcurve As SldWorks.ReferenceCurve
1797 <        Dim attr As SldWorks.Attribute
1798 <        Dim swfeat As SldWorks.Feature
1799 <
1794 >    Private Sub UpdateAttributs(ByRef slyarete1 As SlyAretePoutre, ByVal i As Integer)
1795 >        Dim newArete As sldworks.Edge
1796 >        Dim refcurve As sldworks.ReferenceCurve
1797 >        Dim attr As sldworks.Attribute = Nothing
1798 >        Dim swfeat As sldworks.Feature
1799 >        swModel.EditRebuild3()
1800          swfeat = swModel.FeatureByPositionReverse(0)
1801  
1802 +        Debug.Print(swfeat.Name & "<-- Nom  Typename--> " & swfeat.GetTypeName)
1803 +
1804          refcurve = swfeat.GetSpecificFeature2()
1805          newArete = refcurve.GetFirstSegment()
1806  
1807 <        Dim ParamM As SldWorks.Parameter
1808 <        Dim ParamS As SldWorks.Parameter
1809 <        Dim ParamI1 As SldWorks.Parameter
1810 <        Dim ParamI2 As SldWorks.Parameter
1811 <        Dim ParamD1 As SldWorks.Parameter
1812 <        Dim ParamD2 As SldWorks.Parameter
1813 <        Dim ParamD3 As SldWorks.Parameter
1814 <        Dim ParamD4 As SldWorks.Parameter
1815 <        Dim ParamD5 As SldWorks.Parameter
1816 <        Dim ParamD6 As SldWorks.Parameter
1817 <        Dim ParamAs As SldWorks.Parameter
1818 <        Dim ParamN3 As SldWorks.Parameter
1807 >        Dim ParamM As sldworks.Parameter
1808 >        Dim ParamS As sldworks.Parameter
1809 >        Dim ParamI1 As sldworks.Parameter
1810 >        Dim ParamI2 As sldworks.Parameter
1811 >        Dim ParamD1 As sldworks.Parameter
1812 >        Dim ParamD2 As sldworks.Parameter
1813 >        Dim ParamD3 As sldworks.Parameter
1814 >        Dim ParamD4 As sldworks.Parameter
1815 >        Dim ParamD5 As sldworks.Parameter
1816 >        Dim ParamD6 As sldworks.Parameter
1817 >        Dim ParamAs As sldworks.Parameter
1818 >        Dim ParamN3 As sldworks.Parameter
1819  
1820 <        attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, newArete, "Nouveau" & i & slyarete1.nom, 0, 2)
1820 >        Do While attr Is Nothing
1821 >            attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, newArete, "Nouveau" & i & slyarete1.nom, 0, 2)
1822 >            i += 1
1823 >        Loop
1824  
1825          ParamM = attr.GetParameter("M")
1826          ParamS = attr.GetParameter("S")
# Line 1724 | Line 1846 | Module Intersections
1846          ParamD6.SetDoubleValue2(slyarete1.GetD6, 2, "")
1847          ParamAs.SetDoubleValue2(slyarete1.GetAireSection, 2, "")
1848  
1849 <        Dim p As SldWorks.Parameter
1849 >        Dim p As sldworks.Parameter
1850          p = attr.GetParameter("N3")
1851          p.SetStringValue(slyarete1.GetN3)
1852          p = attr.GetParameter("X3")
# Line 1734 | Line 1856 | Module Intersections
1856          p = attr.GetParameter("Z3")
1857          p.SetDoubleValue2(slyarete1.Z3, 2, "")
1858  
1859 <        Commun.GererDossiers("Poutres", "Nouveau" & i & slyarete1.nom)
1859 >        ' Commun.GererDossiers("Poutres", "Nouveau" & i & slyarete1.nom)
1860  
1861      End Sub
1862  
# Line 1757 | Line 1879 | Module Intersections
1879              For Each coque2 In lst_FaceCoque
1880  
1881                  If DetectFaceFace(coque2, Face1, True, sketch) Then
1882 <                    ' création de l'instance de interFace-face entre coque et coque
1882 >                    ' création de l'instance de interFace-face entre coque et volume
1883 >
1884 >                    Dim vSeg As Object = sketch.GetSketchSegments()
1885 >                    If vSeg Is Nothing Then
1886 >                        DetectFaceFace(coque2, Face1, True, sketch)
1887 >                        vSeg = sketch.GetSketchSegments()
1888 >                        If vSeg Is Nothing Then MsgBox("Problème") : Err.Raise(555)
1889 >                    End If
1890 >
1891  
1892  
1893                      interFF = New InterCoqueVolume
# Line 1773 | Line 1903 | Module Intersections
1903                      coque2.lst_InterCoqueVolume.Add(interFF)
1904                  End If
1905  
1906 <            Next
1907 <        Next
1906 >            Next coque2
1907 >        Next Face1
1908  
1909  
1910  
# Line 1851 | Line 1981 | Module Intersections
1981          Dim u() As Double, v() As Double
1982          Dim angle As Double
1983  
1984 <        If interFF.AreteCoque Is Nothing Then interFF.QuelleAreteCoqueToucheVolume()
1984 >        If interFF.AreteCoque Is Nothing Then interFF.QuelleAreteCoqueToucheVolume() : Dim effacer As New SuperArete(interFF.AreteCoque, True) ': effacer.Colorer(2, 0.7, 0, 0.7)
1985          swArete = interFF.AreteCoque
1986          T = Commun.GetTMilieu(swArete)
1987          vmid = swArete.Evaluate(T)
# Line 1908 | Line 2038 | Module Intersections
2038      ''' </summary>
2039      ''' <remarks></remarks>
2040      Private Sub DécouperCoqueVolume()
2041 +        Static vc As Integer
2042 +        ' Algo:
2043 +        ' Pour chaque coque
2044 +        '   Si on doit couper la coque, alors on la coupe
2045 +        ' On découpe la face du volume
2046 +        ' ON identifie les faces internes
2047 +
2048  
2049          Dim coque1 As SlyFaceCoque
2050          Dim interFF As InterCoqueVolume
2051  
2052          ' 1 - Pour toutes les coques
2053 +        Dim lst_face As New Collections.Generic.List(Of SlyFaceVolume)
2054  
2055          For Each coque1 In Commun.lst_FaceCoque
2056 +
2057              For Each interFF In coque1.lst_InterCoqueVolume
2058 +
2059 +                'If interFF.Face_A_Plat Then
2060 +                '    If Not lst_face.Contains(interFF.sFaceVolume) Then
2061 +                '        lst_face.Add(interFF.sFaceVolume)
2062 +                '        interFF.DécouperFace_A_Plat()
2063 +                '    End If
2064 +
2065 +
2066                  If interFF.FaceDeSection Then
2067                      CoupeCoque1(interFF)
2068 +                    If Not Intersections.MultiDecoupageCoques Then interFF.MarquerFacesInternes()
2069                  Else
2070 <                    interFF.GénérerSweep() ' étape 4
2071 <                    interFF.DécouperVolume() ' étape 5
2072 <                    If interFF.DoitCouperCoque Then ' on découpe aussi couper la coque selon le sweep
2070 >                    interFF.DécouperVolume()
2071 >                    ' s'il y a plus d'une arête sur la coque qui touche au volume alors on doit découper la coque aussi
2072 >                    ' on sélectionne les 2 entités, puis on fait le sketch d'intersection et on évalue le nombre de courbes.
2073 >                    Dim swBod1 As sldworks.Body2 = interFF.sFaceVolume.SwFace.GetBody() : swBod1.Select2(False, Nothing)
2074 >                    Dim swBod2 As sldworks.Body2 = interFF.sFaceCoque.SwFace.GetBody() : swBod2.Select2(True, Nothing)
2075 >
2076 >                    swModel.Sketch3DIntersections()
2077 >                    Dim sketch As sldworks.Sketch = swModel.GetActiveSketch2
2078 >                    swModel.InsertSketch2(True)
2079 >                    Dim swfeatS As sldworks.Feature = swModel.FeatureByPositionReverse(0)
2080 >                    swfeatS.Name = "Vérif_decoupage_coque#" & vc : vc += 1
2081 >
2082 >                    If UBound(sketch.GetSketchSegments) > 1 Then
2083                          interFF.DecouperCoque()
2084 <                        interFF.QuelleAreteCoqueToucheVolume(True)
1927 <                    Else
1928 <                        interFF.QuelleAreteCoqueToucheVolume(False)
2084 >                        interFF.QuelleAreteCoqueToucheVolume()
2085                      End If
2086 <                    If interFF.DerniereCoupe Then interFF.DecouperCoque()
2087 <                    interFF.MarquerFacesInternes() ' étape 6
2086 >
2087 >                    If Not Intersections.MultiDecoupageCoques Then interFF.MarquerFacesInternes() ' étape 6
2088  
2089                  End If
2090 <            Next
2090 >            Next interFF
2091          Next coque1
2092  
2093  
# Line 1945 | Line 2101 | Module Intersections
2101      ''' <param name="int">L'interFaceFace</param>
2102      ''' <remarks></remarks>
2103      Private Sub CoupeCoque1(ByRef int As InterCoqueVolume)
1948        Dim sCoque As SlyFaceCoque
2104          Dim sVol As SlyFaceVolume
2105          Dim swFace As SldWorks.Face2
2106          Dim swent As SldWorks.Entity
# Line 1960 | Line 2115 | Module Intersections
2115          swFace = sVol.SwFace
2116          sVol.Selectionner(0, False)
2117  
2118 <        ' b - lui mettre une esquisse
2119 <        swModel.InsertSketch2(True)
2118 >        '' b - lui mettre une esquisse
2119 >        'swModel.InsertSketch2(True)
2120  
2121 <        ' c - convertir l'esquisse déjà créée
2122 <        sketch = int.sketch
2123 <        swent = sketch
2124 <        swent.Select2(False, 0)
2125 <
2126 <        swModel.SketchUseEdge2(False)
2127 <
2128 <        ' si la face est carrée
2129 <
2130 <        If swFace.GetEdgeCount = 4 Then
2131 <            ' d - ajouter des lignes pour  compléter l'esquisse
2132 <            Dim longueur(3) As Double
2133 <
2134 <
2135 <            Dim vLine As Object
2136 <            Dim line1 As SldWorks.SketchLine, line2 As SldWorks.SketchLine
2137 <            Dim P1 As SldWorks.SketchPoint, P2 As SldWorks.SketchPoint, P3 As SldWorks.SketchPoint, P4 As SldWorks.SketchPoint
2138 <            Dim skSeg As SldWorks.SketchSegment
2139 <            vEdges = swFace.GetEdges()
2140 <            For Each swArete In vEdges
2141 <                ReDim Preserve aretes(i)
2142 <                aretes(i) = swArete
2143 <                i += 1
2144 <            Next
2145 <            For i = 0 To 3
2146 <                longueur(i) = Commun.GetLongueurArete(vEdges(i))
2147 <            Next i
2148 <            longueur = Ordonner(longueur, aretes)
2121 >        '' c - convertir l'esquisse déjà créée
2122 >        'sketch = int.sketch
2123 >        'swent = sketch
2124 >        'swent.Select2(False, 0)
2125 >
2126 >        'swModel.SketchUseEdge2(False)
2127 >
2128 >        '' si la face est carrée
2129 >
2130 >        'If swFace.GetEdgeCount = 4 Then
2131 >        '    ' d - ajouter des lignes pour  compléter l'esquisse
2132 >        '    Dim longueur(3) As Double
2133 >
2134 >
2135 >        '    Dim vLine As Object
2136 >        '    Dim line1 As SldWorks.SketchLine, line2 As SldWorks.SketchLine
2137 >        '    Dim P1 As SldWorks.SketchPoint, P2 As SldWorks.SketchPoint, P3 As SldWorks.SketchPoint, P4 As SldWorks.SketchPoint
2138 >        '    Dim skSeg As SldWorks.SketchSegment
2139 >        '    vEdges = swFace.GetEdges()
2140 >        '    For Each swArete In vEdges
2141 >        '        ReDim Preserve aretes(i)
2142 >        '        aretes(i) = swArete
2143 >        '        i += 1
2144 >        '    Next
2145 >        '    For i = 0 To 3
2146 >        '        longueur(i) = Commun.GetLongueurArete(vEdges(i))
2147 >        '    Next i
2148 >        '    longueur = Ordonner(longueur, aretes)
2149 >
2150 >        '    swent = aretes(3) : swent.Select2(False, 0) ' on prend la plus grande arète
2151 >        '    swModel.SketchUseEdge2(False)
2152 >        '    sketch = swModel.GetActiveSketch()
2153 >        '    vLine = sketch.GetSketchSegments()
2154 >        '    skSeg = vLine(0) : line1 = skSeg
2155 >        '    skSeg = vLine(1) : line2 = skSeg
2156 >
2157 >        '    P1 = line1.GetStartPoint2()
2158 >        '    P2 = line1.GetEndPoint2()
2159 >        '    P3 = line2.GetStartPoint2()
2160 >        '    P4 = line2.GetEndPoint2()
2161 >
2162 >        '    If Distance(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z) < Distance(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z) Then ' ligne entre 1 et 3
2163 >        '        swModel.CreateLine2(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z)
2164 >        '        swModel.CreateLine2(P2.X, P2.Y, P2.Z, P4.X, P4.Y, P4.Z)
2165 >        '    Else ' ligne entre 1 et 4 & 2 et 3
2166 >        '        swModel.CreateLine2(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z)
2167 >        '        swModel.CreateLine2(P2.X, P2.Y, P2.Z, P3.X, P3.Y, P3.Z)
2168 >        '    End If
2169 >        'Else
2170 >        '    sketch = swModel.GetActiveSketch()
2171 >        'End If
2172 >        'swModel.InsertSketch2(True)
2173  
1995            swent = aretes(3) : swent.Select2(False, 0) ' on prend la plus grande arète
1996            swModel.SketchUseEdge2(False)
1997            sketch = swModel.GetActiveSketch()
1998            vLine = sketch.GetSketchSegments()
1999            skSeg = vLine(0) : line1 = skSeg
2000            skSeg = vLine(1) : line2 = skSeg
2001
2002            P1 = line1.GetStartPoint2()
2003            P2 = line1.GetEndPoint2()
2004            P3 = line2.GetStartPoint2()
2005            P4 = line2.GetEndPoint2()
2006
2007            If Distance(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z) < Distance(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z) Then ' ligne entre 1 et 3
2008                swModel.CreateLine2(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z)
2009                swModel.CreateLine2(P2.X, P2.Y, P2.Z, P4.X, P4.Y, P4.Z)
2010            Else ' ligne entre 1 et 4 & 2 et 3
2011                swModel.CreateLine2(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z)
2012                swModel.CreateLine2(P2.X, P2.Y, P2.Z, P3.X, P3.Y, P3.Z)
2013            End If
2014        Else
2015            sketch = swModel.GetActiveSketch()
2016        End If
2017        swModel.InsertSketch2(True)
2174  
2175 +        '' e - splitter
2176 +        'swent = swFace : swent.Select2(False, 1)
2177 +        'swent = sketch : swent.Select2(True, 4)
2178 +        'swModel.InsertSplitLineProject(False, False)
2179  
2020        ' e - splitter
2021        swent = swFace : swent.Select2(False, 1)
2022        swent = sketch : swent.Select2(True, 4)
2023        swModel.InsertSplitLineProject(False, False)
2180  
2181 +        sVol.Selectionner(32, False) 'swPart.Extension.SelectByID2("", "FACE", 0.05746341258515, 0.007456177698316, 0.04437034503314, False, 16, Nothing, 0)
2182 +        int.sFaceCoque.Selectionner(16, True) 'swPart.Extension.SelectByID2("", "FACE", 0.03921396269902, -0.007016448377556, 0, True, 32, Nothing, 0)
2183 +        swPart.FeatureManager.InsertSplitLineIntersect(7)
2184  
2185          ' f - mettre un FaceInterne sur les 2 faces résultantes.
2186          Dim swFeat As SldWorks.Feature
# Line 2036 | Line 2195 | Module Intersections
2195          swFace1 = vFace(0)
2196          swFace2 = vFace(1)
2197  
2198 <        swent = swFace1
2199 <        attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2200 <        nom = "FaceInterneCoque1"
2201 <        If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2) ' 0 = swThisconfig
2202 <
2203 <        While attr Is Nothing
2204 <            no += 1
2205 <            nom = "FaceInterneCoque" & CStr(no)
2206 <            attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2)
2207 <        End While
2208 <        GererDossiers("FaceInternes", nom)
2209 <
2210 <        swent = swFace2
2211 <        attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2212 <        nom = "FaceInterneCoque1"
2213 <        If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2) ' 0 = swThisconfig
2214 <
2215 <        While attr Is Nothing
2216 <            no += 1
2217 <            nom = "FaceInterneCoque" & CStr(no)
2218 <            attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2)
2219 <        End While
2220 <        GererDossiers("FaceInternes", nom)
2198 >        sVol.AjouterFace(swFace1)
2199 >        sVol.AjouterFace(swFace2)
2200 >
2201 >        'Dim eFace As New SlyFaceVolume(swFace1, True)
2202 >        'eFace.MettreAttributFaceInterne(swFace1, , False)
2203 >
2204 >        'swent = swFace1
2205 >        'attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2206 >        'nom = "FaceInterneCoque1"
2207 >        'If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2) ' 0 = swThisconfig
2208 >
2209 >        'While attr Is Nothing
2210 >        '    no += 1
2211 >        '    nom = "FaceInterneCoque" & CStr(no)
2212 >        '    attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2)
2213 >        'End While
2214 >        'GererDossiers("FaceInternes", nom)
2215 >
2216 >        'swent = swFace2
2217 >        'attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2218 >        'nom = "FaceInterneCoque1"
2219 >        'If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2) ' 0 = swThisconfig
2220 >
2221 >        'While attr Is Nothing
2222 >        '    no += 1
2223 >        '    nom = "FaceInterneCoque" & CStr(no)
2224 >        '    attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2)
2225 >        'End While
2226 >        'GererDossiers("FaceInternes", nom)
2227  
2228  
2229      End Sub
# Line 2088 | Line 2253 | Module Intersections
2253      ''' <param name="face1">Première face</param>
2254      ''' <param name="face2">Seconde face</param>
2255      ''' <param name="dessiner">Si l'on veut dessiner une esquisse contenant la courbe</param>
2256 <    ''' <param name="Sketch">Si la première option est vrai, ce paramètre redonne l'esquisse qui contient la courbe</param>
2256 >    ''' <param name="Sketch">Si la précédente option est vrai, ce paramètre redonne l'esquisse qui contient la courbe (peut contenir plusieurs segments) d'intersection</param>
2257      ''' <returns>Vrai si les faces se touchent</returns>
2258      ''' <remarks>Si les 2 faces se touchent en un seul point alors ça retourne faux.</remarks>
2259      Private Function DetectFaceFace(ByRef face1 As SldWorks.Face2, ByRef face2 As SldWorks.Face2, Optional ByRef dessiner As Boolean = False, Optional ByRef Sketch As SldWorks.Sketch = Nothing) As Boolean
2260 <        ' sub qui détecte si 2 faces se touchent et retourne vrai si c'est le cas.
2261 <        Dim Surface1 As SldWorks.Surface
2262 <        Dim Surface2 As SldWorks.Surface
2260 >        'sub qui détecte si 2 faces se touchent et retourne vrai si c'est le cas.
2261 >        Dim Surface1 As sldworks.Surface
2262 >        Dim Surface2 As sldworks.Surface
2263          Dim curveArray As Object = Nothing
2264 <        Dim curve As SldWorks.Curve
2264 >        Dim curve As sldworks.Curve
2265          Dim ret As Boolean
2266          Dim boundsArray As Object = Nothing
2267          Dim bounds() As Double
# Line 2117 | Line 2282 | Module Intersections
2282          If Not ret Then Return False
2283          bounds = boundsArray
2284  
2120        'On Error GoTo faceSurFace
2285          Try
2286              curve = curveArray(0)
2287          Catch
2288 <            Debug.Write("On a une intersection où 2 faces sont sur la même surface...")
2289 <            Return False ' ouch... pas certain.
2288 >            Return False  'GoTo Fairesketch 'ne va pas toujours marcher, mais je n'ai rien de mieu pour l'instant...
2289 >            'MsgBox("On a une intersection où 2 faces sont sur la même surface...") ' en théorie...
2290 >            ' ouch... pas certain.
2291          End Try
2292  
2293  
# Line 2133 | Line 2298 | Module Intersections
2298              Dim vParam As Object
2299              vParam = curve.GetClosestPointOn(P1(0), P1(1), P1(2))  ' vparam(3) est le U
2300  
2301 <            P1 = curve.Evaluate(vParam(3) + 100 * Epsilon) : Point1 = P1
2302 <            P2 = curve.Evaluate(vParam(3) - 100 * Epsilon) : Point2 = P2
2301 >            P1 = curve.Evaluate(vParam(3) + 100000 * Epsilon) : Point1(0) = P1(0) : Point1(1) = P1(1) : Point1(2) = P1(2)
2302 >            P2 = curve.Evaluate(vParam(3) - 100000 * Epsilon) : Point2(0) = P2(0) : Point2(1) = P2(1) : Point2(2) = P2(2)
2303 >
2304 >            ' si p1 et p2 sont identiques alors on a un point D'intersection, ce que l'on ne veut pas
2305 >            If Distance(Point1, Point2) < 1000 * Epsilon Then Return False
2306  
2307 <            If (Distance(face1, Point1(0), Point1(1), Point1(2)) < Epsilon) And (Distance(face2, Point1(0), Point1(1), Point1(2)) < Epsilon) Then
2308 <            ElseIf (Distance(face1, Point2(0), Point2(1), Point2(2)) < Epsilon) And (Distance(face2, Point2(0), Point2(1), Point2(2)) < Epsilon) Then
2307 >            If ((Distance(face1, Point1(0), Point1(1), Point1(2)) < (1000 * Epsilon)) AndAlso (Distance(face2, Point1(0), Point1(1), Point1(2)) < (1000 * Epsilon))) OrElse ((Distance(face1, Point2(0), Point2(1), Point2(2)) < (Epsilon * 1000)) AndAlso (Distance(face2, Point2(0), Point2(1), Point2(2)) < (1000 * Epsilon))) Then
2308 >                ' return true
2309              Else
2310 <                Return False
2310 >
2311 >                Dim swent2 As sldworks.Entity
2312 >                Dim feat2 As sldworks.Feature
2313 >                swModel.Insert3DSketch2(False)
2314 >                swModel.ClearSelection2(True)
2315 >                'swent2 = face1 : swent2.Select2(False, 0)
2316 >                'swent2 = face2 : swent2.Select2(True, 0)
2317 >                Dim swBod1 As sldworks.Body2 = face1.GetBody : swBod1.Select2(False, Nothing)
2318 >                Dim swBod2 As sldworks.Body2 = face2.GetBody : swBod2.Select2(True, Nothing)
2319 >
2320 >                swModel.Sketch3DIntersections()
2321 >
2322 >                swModel.Insert3DSketch2(False)
2323 >                swModel.EditRebuild3()
2324 >                feat2 = swModel.FeatureByPositionReverse(0)
2325 >
2326 >                Debug.Print(feat2.Name)
2327 >
2328 >                Sketch = feat2.GetSpecificFeature2
2329 >                feat2.Name = "TouchePas" & CStr(Rnd())
2330 >                'MsgBox(face1.GetArea)
2331 >                Dim vSeg2 As Object = Sketch.GetSketchSegments()
2332 >                If vSeg2 Is Nothing Then
2333 >                    swent2 = feat2
2334 >                    swent2.Select(False)
2335 >                    swModel.EditDelete()
2336 >                    Return False
2337 >                Else
2338 >                    If Math.Abs(bounds(0)) > 490 Then Return False ' se touchent à l'infini...
2339 >                    Return True
2340 >                End If
2341 >
2342              End If
2343          End If
2344  
2345 + Fairesketch:
2346 +        Dim swent As sldworks.Entity
2347 +        Dim feat As sldworks.Feature
2348 +        swModel.Insert3DSketch2(False)
2349 +        swModel.ClearSelection2(True)
2350 +        'swent = face1 : swent.Select2(False, 0)
2351 +        'swent = face2 : swent.Select2(True, 0)
2352 +        Dim swBod1a As sldworks.Body2 = face1.GetBody : swBod1a.Select2(False, Nothing)
2353 +        Dim swBod2a As sldworks.Body2 = face2.GetBody : swBod2a.Select2(True, Nothing)
2354  
2355 +        swModel.Sketch3DIntersections()
2356  
2357 <        If dessiner Then
2358 <            Dim swent As SldWorks.Entity
2359 <            Dim feat As SldWorks.Feature
2360 <            swModel.Insert3DSketch2(False)
2361 <
2362 <            swent = face1 : swent.Select2(False, 0)
2363 <            swent = face2 : swent.Select2(True, 0)
2364 <            swModel.Sketch3DIntersections()
2365 <
2366 <            swModel.Insert3DSketch2(False)
2367 <            swModel.EditRebuild3()
2368 <            feat = swModel.FeatureByPositionReverse(0)
2369 <
2161 <            Sketch = feat.GetSpecificFeature2
2357 >        swModel.Insert3DSketch2(False)
2358 >        swModel.EditRebuild3()
2359 >        feat = swModel.FeatureByPositionReverse(0)
2360 >        Debug.Print(feat.Name)
2361 >        Sketch = feat.GetSpecificFeature2
2362 >        Dim vSeg As Object = Sketch.GetSketchSegments()
2363 >        If vSeg Is Nothing Then
2364 >            swent = feat
2365 >            swent.Select(False)
2366 >            swModel.EditDelete()
2367 >            Return False
2368 >        Else
2369 >            Return True
2370          End If
2371  
2372          Return True
2165        'If curve.IsTrimmedCurve = False And curve.IsLine Then    ' si c'est une ligne, alors l'enfoirée est de longueur infinie. courbe spline... pas de problèmes.
2373  
2167        '    Dim vEdge As Object, swAreteTest As SldWorks.Edge, xyz() As Double = Nothing, n As Integer
2168        '    Dim lst_T() As Double = Nothing, final() As Double
2169        '    Dim NewCourbe As SldWorks.Curve
2170
2171        '    For n = 1 To 2
2172        '        If n = 1 Then vEdge = face1.GetEdges() Else vEdge = face2.GetEdges()
2173        '        For f = 0 To UBound(vEdge)
2174        '            swAreteTest = vEdge(f)
2175        '            If DetectAreteArete(swAreteTest, curve, xyz) Then
2176
2177        '                If Not UBound(xyz) > 4 Then
2178        '                    vT = curve.GetClosestPointOn(xyz(0), xyz(1), xyz(2))
2179        '                    T = vT(3)
2180
2181        '                    If lst_T Is Nothing Then ReDim lst_T(0) Else ReDim Preserve lst_T(UBound(lst_T) + 1)
2182        '                    lst_T(UBound(lst_T)) = T
2183        '                End If
2184        '            End If
2185        '        Next f
2186        '    Next n
2187
2188        '    final = trier(lst_T)
2189
2190        '    For i = 0 To UBound(final) Step 2
2191        '        Dim skseg As SldWorks.SketchSegment, angle As Double
2192
2193        '        Point1 = curve.Evaluate(final(i)) : Point2 = curve.Evaluate(final(i + 1))
2194        '        NewCourbe = curve.CreateTrimmedCurve2(Point1(0), Point1(1), Point1(2), Point2(0), Point2(1), Point2(2))
2195        '        If dessiner Then skseg = Commun.DessineCourbe(NewCourbe) : Sketch = skseg.GetSketch
2196        '        angle = AngleEntre2Faces(face1, face2, Point1) / 0.0174532925
2197
2198        '        'swApp.SendMsgToUser(" Courbe Droite " & angle)
2199        '    Next
2200
2201        'ElseIf curve.IsTrimmedCurve = False Then  ' courbe périodique... donc pas trimmée mais avec des bounds...
2202        '    If dessiner Then
2203        '        Commun.DessineCourbe(curve)
2204        '        Sketch = swModel.FeatureByPositionReverse(0)
2205        '    End If
2206
2207
2208        'Else
2209        '    If dessiner Then
2210        '        Commun.DessineCourbe(curve)
2211        '        Sketch = swModel.FeatureByPositionReverse(0)
2212        '    End If
2213        'End If
2214
2215        'Return True
2216 faceSurFace:  ' les 2 surfaces sont une sur l'autre...
2217        'Dim swent As SldWorks.Entity
2218        'Dim swent2 As SldWorks.Entity
2219        'swent = face1 : swent.Select2(False, 0)
2220        'swent2 = face2 : swent2.Select2(True, 0)
2221        'MsgBox("2 Faces avec une surface commune...")
2222        'Return True
2374      End Function
2375  
2376  
# Line 2292 | Line 2443 | faceSurFace:  ' les 2 surfaces sont une
2443      End Function
2444  
2445  
2446 +    ''' <summary>
2447 +    ''' Sub qui fait comme le tavail de Antoine et Rémi et qui créé un fichier pour la carte de taille.  Si l'option de pré-optimisation est enclenchée, la sub ne fait qu'ajouter des éléments au fichier .txt
2448 +    ''' </summary>
2449 +    ''' <remarks></remarks>
2450 +    Public Sub FairePreCarte()
2451 +
2452 +        Dim ligne_txt As String
2453 +        Dim fichier As System.IO.StreamWriter
2454 +        Dim EcartNodal As Double = Commun.ÉcartNodal
2455 +
2456 +        ' si le fichier pog n'est pas encore créé, on doit le faire...
2457 +        If Commun.NomFichierPog = Nothing Then
2458 +            ' la première ligne donne la boite englobante, la seconde la taille ENG
2459 +
2460 +            Dim path As String = Nothing
2461 +            Dim CMDialogl As New Windows.Forms.SaveFileDialog
2462 +            CMDialogl.DefaultExt = ".txt"
2463 +            CMDialogl.Filter = "Fichiers PoG (*.txt)|*.txt|Tout fichiers(*.*)|*.*"
2464 +
2465 +            CMDialogl.OverwritePrompt = True
2466 +            CMDialogl.Title = "Sélectionnez le fichier pour enregistrer les points"
2467 +            CMDialogl.ShowDialog()
2468 +            path = CMDialogl.FileName
2469 +            path = Txtpath(path) : Commun.NomFichierPog = path
2470 +            If path Is Nothing Or path = "" Then MsgBox("Aucun fichier sélectionné, sortie du programme!", MsgBoxStyle.Critical, "Erreur!")
2471 +
2472 +            fichier = System.IO.File.CreateText(path)
2473 +
2474 +            Dim vBox As Object = swPart.GetPartBox(True)
2475 +            Dim box() As Double = vBox
2476 +
2477 +            Dim centre(2) As Double ' le centre de la boite englobante
2478 +            Dim longueurs(2) As Double
2479 +
2480 +            centre(0) = (box(3) + box(0)) / 2
2481 +            centre(1) = (box(4) + box(1)) / 2
2482 +            centre(2) = (box(5) + box(2)) / 2
2483 +
2484 +            longueurs(0) = (box(3) - box(0)) * 1.25
2485 +            longueurs(1) = (box(4) - box(1)) * 1.25
2486 +            longueurs(2) = (box(5) - box(2)) * 1.25
2487 +
2488 +
2489 +            ligne_txt = CStr(centre(0) - longueurs(0) / 2) & " " & CStr(centre(1) - longueurs(1) / 2) & " " & CStr(centre(2) - longueurs(2) / 2) & " " & CStr(centre(0) + longueurs(0) / 2) & " " & CStr(centre(1) + longueurs(1) / 2) & " " & CStr(centre(2) + longueurs(2) / 2)
2490 +            fichier.WriteLine(Replace(ligne_txt, ",", "."))
2491 +
2492 +            fichier.WriteLine(Replace(CStr(EcartNodal), ",", "."))
2493 +        Else
2494 +            ' Le fichier pog existe déjà...
2495 +            fichier = System.IO.File.AppendText(Commun.NomFichierPog)
2496 +            'fichier.WriteLine(Replace(CStr(EcartNodal), ",", "."))
2497 +        End If
2498 +
2499 +
2500 +        ' *** C'est ici que le fun se passe.
2501 +
2502 +
2503 +        ' 1 - On parcourt toutes les faces, les listes sont déjà RE-crées, donc pas de multifaces
2504 +        For Each sFace As SlyFaceVolume In Commun.lst_FaceVolume
2505 +            sFace.MettrePointSurPOG(fichier)
2506 +        Next
2507 +
2508 +        For Each sFace As SlyFaceCoque In Commun.lst_FaceCoque
2509 +            sFace.MettrePointSurPOG(fichier)
2510 +        Next
2511 +
2512 +        ' *** Fin
2513 +        fichier.Close()
2514 +    End Sub
2515 +
2516 +    ''' <summary>
2517 +    ''' Fonction qui compare 2 surfaces
2518 +    ''' </summary>
2519 +    ''' <param name="swSurf1">La première surface</param>
2520 +    ''' <param name="swSurf2">La seconde</param>
2521 +    ''' <returns>Vrai si les 2 surfaces sont identiques, faux sinon</returns>
2522 +    ''' <remarks></remarks>
2523 +    Public Function ComparerSurfaces(ByRef swSurf1 As sldworks.Surface, ByRef swSurf2 As sldworks.Surface) As Boolean
2524 +        'swSurf1.GetBSurfParams2(True,False,
2525 +
2526 +
2527 +        If swSurf1.IsPlane And swSurf2.IsPlane Then
2528 +            Dim obj1 As Object = swSurf1.PlaneParams
2529 +            Dim obj2 As Object = swSurf2.PlaneParams
2530 +            For i As Integer = 0 To 2
2531 +                If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2532 +            Next
2533 +            Return True
2534 +        ElseIf swSurf1.IsBlending And swSurf2.IsBlending Then
2535 +            ' pas de blendingParams
2536 +
2537 +        ElseIf swSurf1.IsCone And swSurf2.IsCone Then
2538 +            Dim obj1 As Object = swSurf1.ConeParams
2539 +            Dim obj2 As Object = swSurf2.ConeParams
2540 +            For i As Integer = 0 To 7
2541 +                If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2542 +            Next
2543 +            Return True
2544 +
2545 +        ElseIf swSurf1.IsCylinder And swSurf2.IsCylinder Then
2546 +            Dim obj1 As Object = swSurf1.CylinderParams
2547 +            Dim obj2 As Object = swSurf2.CylinderParams
2548 +            For i As Integer = 0 To 6
2549 +                If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2550 +            Next
2551 +            Return True
2552 +        ElseIf swSurf1.IsForeign And swSurf2.IsForeign Then
2553 +            ' ???
2554 +        ElseIf swSurf1.IsOffset And swSurf2.IsOffset Then
2555 +            ' Pas de offsetParam
2556 +
2557 +        ElseIf swSurf1.IsParametric And swSurf2.IsParametric Then
2558 +            ' pas de ParametricParams
2559 +
2560 +        ElseIf swSurf1.IsRevolved And swSurf2.IsRevolved Then
2561 +            ' pas de revolvedparams
2562 +
2563 +        ElseIf swSurf1.IsSphere And swSurf2.IsSphere Then
2564 +            Dim obj1 As Object = swSurf1.SphereParams
2565 +            Dim obj2 As Object = swSurf2.SphereParams
2566 +
2567 +            For i As Integer = 0 To 3
2568 +                If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2569 +            Next
2570 +            Return True
2571 +        ElseIf swSurf1.IsSwept And swSurf2.IsSwept Then
2572 +            ' merde, il n'y a pas de Sweptparams
2573 +
2574 +        ElseIf swSurf1.IsTorus And swSurf2.IsTorus Then
2575 +            Dim obj1 As Object = swSurf1.TorusParams
2576 +            Dim obj2 As Object = swSurf2.TorusParams
2577 +
2578 +            For i As Integer = 0 To 7
2579 +                If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2580 +            Next
2581 +            Return True
2582 +        Else
2583 +            ' faut quand même évaluer si on a la bonne chose...
2584 +            Try
2585 +                Dim pt As Object = swSurf1.Evaluate(0.5, 0.5, 0, 0)
2586 +                Dim obj As Object = swSurf1.GetClosestPointOn(pt(0), pt(1), pt(2)) ' x, y , z, U, V
2587 +                Dim obj1 As Object = swSurf1.EvaluateAtPoint(obj(0), obj(1), obj(2))
2588 +
2589 +                Dim objb As Object = swSurf2.GetClosestPointOn(pt(0), pt(1), pt(2)) ' x, y , z, U, V
2590 +                Dim obj2 As Object = swSurf2.EvaluateAtPoint(objb(0), objb(1), objb(2))
2591 +
2592 +                If Math.Abs(obj1(9) - obj2(9)) < Epsilon And Math.Abs(obj1(10) - obj2(10)) < Epsilon Then
2593 +                    ' c'est cheap.... mais
2594 +                    Return True
2595 +                End If
2596 +                Return False
2597 +            Catch
2598 +                Return False
2599 +            End Try
2600 +
2601 +        End If
2602 +
2603 +        Return False
2604 +
2605 +
2606 +
2607 +    End Function
2608 +
2609  
2610  
2611   End Module

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines