| 20 |
|
Public Sub New(ByRef swArete As SldWorks.Edge, ByRef encapsulateur As Boolean) |
| 21 |
|
Me.swArete = swArete |
| 22 |
|
Me.swCourbe = swArete.GetCurve |
| 23 |
+ |
|
| 24 |
+ |
|
| 25 |
|
End Sub |
| 26 |
|
|
| 27 |
+ |
|
| 28 |
+ |
|
| 29 |
|
Public Sub New(ByRef arete As SldWorks.Edge, Optional ByVal tip As Integer = 0) |
| 30 |
|
Me.swArete = arete |
| 31 |
|
Me.swCourbe = swArete.GetCurve |
| 53 |
|
Try |
| 54 |
|
retval = swPart.SetEntityName(ent, nom) |
| 55 |
|
Catch |
| 52 |
– |
Debug.Write("Le prog ne veut pas mettre le nom sur une entité.." & vbCr & "Le nom devrait être: " & nom) ' MsgBox("Le prog ne veut pas mettre le nom sur une entité.." & vbCr & "Le nom devrait être: " & nom) |
| 53 |
– |
End Try |
| 56 |
|
|
| 57 |
< |
Dim i As Integer |
| 58 |
< |
If retval = False Then |
| 59 |
< |
Do Until retval = True |
| 60 |
< |
i += 1 |
| 61 |
< |
retval = swPart.SetEntityName(ent, nom & Chr(96 + i)) |
| 62 |
< |
Loop |
| 63 |
< |
Me.nom = nom & Chr(96 + i) |
| 64 |
< |
Debug.Write("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom." & Chr(13) & nom) ' MsgBox("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom." & Chr(13) & nom, MsgBoxStyle.Critical, "Problème dans le setID de l'arrète") |
| 65 |
< |
End If |
| 57 |
> |
|
| 58 |
> |
Dim i As Integer |
| 59 |
> |
If retval = False Then |
| 60 |
> |
Do Until retval = True |
| 61 |
> |
i += 1 |
| 62 |
> |
retval = swPart.SetEntityName(ent, nom & Chr(96 + i)) |
| 63 |
> |
Loop |
| 64 |
> |
Me.nom = nom & Chr(96 + i) |
| 65 |
> |
'MsgBox("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom." & Chr(13) & nom) ' MsgBox("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom." & Chr(13) & nom, MsgBoxStyle.Critical, "Problème dans le setID de l'arrète") |
| 66 |
> |
End If |
| 67 |
> |
MsgBox("Le prog ne veut pas mettre le nom sur une entité.." & vbCr & "Le nom devrait être: " & nom) ' MsgBox("Le prog ne veut pas mettre le nom sur une entité.." & vbCr & "Le nom devrait être: " & nom) |
| 68 |
> |
End Try |
| 69 |
|
End Sub |
| 70 |
|
|
| 71 |
|
Shared Sub reinitialiser() |
| 171 |
|
''' Renvoie les coordonnées du point milieu |
| 172 |
|
''' </summary> |
| 173 |
|
''' <returns></returns> |
| 174 |
< |
''' <remarks></remarks> |
| 175 |
< |
Public Function GetPointMilieu() As Double() |
| 174 |
> |
''' <remarks>Attention: Ce sont les coordonnées du point à T milieu, ce qui n'est pas nécessairement le milieu de l'arète dans le cas de b-spline </remarks> |
| 175 |
> |
Public Function GetPointMilieu(Optional ByVal Reverse As Boolean = False) As Double() |
| 176 |
|
Dim T As Double |
| 177 |
|
Dim xyz(2) As Double |
| 178 |
< |
T = Me.GetTMilieu |
| 178 |
> |
T = Me.GetTMilieu(Reverse) |
| 179 |
|
Me.Evaluer(T, xyz) |
| 180 |
|
Return xyz |
| 181 |
|
End Function |
| 183 |
|
''' <summary> |
| 184 |
|
''' Renvoie les coordonnées du point milieu |
| 185 |
|
''' </summary> |
| 186 |
< |
''' <returns>Faux si le sommet n'esiste pas</returns> |
| 186 |
> |
''' <returns>Faux si le sommet n'existe pas</returns> |
| 187 |
|
''' <remarks></remarks> |
| 188 |
< |
Public Function GetPointMilieu(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Boolean |
| 188 |
> |
Public Function GetPointMilieu(ByRef x As Double, ByRef y As Double, ByRef z As Double, Optional ByVal Reverse As Boolean = False) As Boolean |
| 189 |
|
Dim T As Double |
| 190 |
< |
T = Me.GetTMilieu |
| 190 |
> |
T = Me.GetTMilieu(Reverse) |
| 191 |
|
Me.Evaluer(T, x, y, z) |
| 192 |
|
Return True |
| 193 |
|
End Function |
| 201 |
|
''' <returns>Vrai si la courbe est une ligne</returns> |
| 202 |
|
''' <remarks></remarks> |
| 203 |
|
Public Function IsLine() As Boolean |
| 204 |
+ |
|
| 205 |
+ |
Dim ev As Object = Me.swArete.Evaluate(0.2) |
| 206 |
+ |
Dim cr As sldworks.Curve = Me.swArete.GetCurve |
| 207 |
+ |
|
| 208 |
|
Try |
| 209 |
< |
Dim swCourbe As SldWorks.Curve = Me.swArete.GetCurve |
| 210 |
< |
Return swCourbe.IsLine() |
| 209 |
> |
Dim swCourbe As sldworks.Curve = Me.swArete.GetCurve |
| 210 |
> |
Select Case swCourbe.Identity() |
| 211 |
> |
|
| 212 |
> |
Case swconst.swCurveTypes_e.LINE_TYPE |
| 213 |
> |
Return True |
| 214 |
> |
|
| 215 |
> |
Case Else |
| 216 |
> |
Return False |
| 217 |
> |
End Select |
| 218 |
> |
|
| 219 |
|
Catch |
| 220 |
< |
Dim fault As SldWorks.FaultEntity = Me.swArete.Check |
| 221 |
< |
Debug.WriteLine("N'arrive pas à déterminer si la courbe est une ligne" & vbCr & "FaultEntity.Count = " & IIf(fault Is Nothing, "0", fault.Count) & vbCr & Me.nom) |
| 222 |
< |
Return True |
| 220 |
> |
' on a un drole de type de courbe... on ne peut dire si c'est une ligne ou autre... |
| 221 |
> |
Try |
| 222 |
> |
Dim swCourbe2 As sldworks.Curve = swCourbe.GetBaseCurve |
| 223 |
> |
Select Case swCourbe2.Identity() |
| 224 |
> |
|
| 225 |
> |
Case swconst.swCurveTypes_e.LINE_TYPE |
| 226 |
> |
Return True |
| 227 |
> |
|
| 228 |
> |
Case Else |
| 229 |
> |
Return False |
| 230 |
> |
End Select |
| 231 |
> |
Catch ex As Exception |
| 232 |
> |
|
| 233 |
> |
End Try |
| 234 |
> |
|
| 235 |
> |
|
| 236 |
> |
Return False |
| 237 |
|
End Try |
| 238 |
|
|
| 239 |
|
End Function |
| 240 |
|
|
| 241 |
+ |
|
| 242 |
+ |
''' <summary> |
| 243 |
+ |
''' Retourne vrai si la courbe est fermée |
| 244 |
+ |
''' </summary> |
| 245 |
+ |
''' <value></value> |
| 246 |
+ |
''' <returns></returns> |
| 247 |
+ |
''' <remarks></remarks> |
| 248 |
+ |
Public ReadOnly Property IsClosed() As Boolean |
| 249 |
+ |
Get |
| 250 |
+ |
If Me.swArete.GetStartVertex Is Nothing Then Return False Else Return True |
| 251 |
+ |
End Get |
| 252 |
+ |
End Property |
| 253 |
+ |
|
| 254 |
|
''' <summary> |
| 255 |
|
''' Détermine si la courbe est un cercle |
| 256 |
|
''' </summary> |
| 257 |
|
''' <returns>Vrai si la courbe est un cercle</returns> |
| 258 |
|
''' <remarks></remarks> |
| 259 |
|
Public Function IsCircle() As Boolean |
| 260 |
+ |
|
| 261 |
|
Try |
| 262 |
|
|
| 263 |
< |
Dim swCourbe As SldWorks.Curve = Me.swArete.GetCurve |
| 219 |
< |
If swCourbe.IsLine Then Return False |
| 263 |
> |
If Me.swCourbe.IsLine Then Return False |
| 264 |
|
Return Me.swCourbe.IsCircle |
| 265 |
|
Catch ex As Exception |
| 266 |
< |
Dim fault As SldWorks.FaultEntity = Me.swArete.Check |
| 266 |
> |
Dim fault As sldworks.FaultEntity = Me.swArete.Check |
| 267 |
|
Debug.WriteLine("N'arrive pas à déterminer si la courbe est un cercle" & vbCr & "FaultEntity.Count = " & IIf(fault Is Nothing, "0", fault.Count) & vbCr & Me.nom) |
| 268 |
+ |
|
| 269 |
+ |
Try |
| 270 |
+ |
If swCourbe.Identity() = swconst.swCurveTypes_e.CIRCLE_TYPE Then Return True Else Return False |
| 271 |
+ |
|
| 272 |
+ |
Catch |
| 273 |
+ |
Debug.Print("Même merde que pour la ligne, le lien entre la courbe et le pointeur se perd par magie!") |
| 274 |
+ |
End Try |
| 275 |
+ |
|
| 276 |
|
Return False |
| 277 |
|
End Try |
| 278 |
|
|
| 339 |
|
|
| 340 |
|
|
| 341 |
|
''' <summary> |
| 342 |
< |
''' Sub qui met ou Update les paramètres des doublons des arètes |
| 342 |
> |
''' Sub qui met ou Update les paramètres des doublons des arètes. Une entité avec un attribut de doublon est ignoré par MAGiC |
| 343 |
|
''' </summary> |
| 344 |
|
''' <param name="Numero">Le numéro que l'on veut attribuer</param> |
| 345 |
|
''' <param name="Maitre">Si ce,st un maitre on met true</param> |
| 388 |
|
Dim SlySommetTest As SlySommetVolume |
| 389 |
|
|
| 390 |
|
For Each SlySommetTest In Commun.lst_SommetVolume |
| 391 |
< |
If Not premier AndAlso Distance(esom1.GetSommet, SlySommetTest.swSommet) < Epsilon Then ' on vient de trouver le sommet du volume |
| 391 |
> |
If Not premier AndAlso Distance(esom1.GetSommet, SlySommetTest.swSommet) < (10000 * Epsilon) Then ' on vient de trouver le sommet du volume |
| 392 |
|
esom1.MettreAttributDoublonSommet(SlySommetTest.nom, SlySommetTest.swSommet) |
| 393 |
|
premier = True |
| 394 |
< |
ElseIf Distance(esom2.GetSommet, SlySommetTest.swSommet) < Epsilon Then |
| 394 |
> |
ElseIf Distance(esom2.GetSommet, SlySommetTest.swSommet) < (10000 * Epsilon) Then |
| 395 |
|
esom2.MettreAttributDoublonSommet(SlySommetTest.nom, SlySommetTest.swSommet) |
| 396 |
|
second = True |
| 397 |
|
End If |
| 403 |
|
' trouver si le sens est le même, mettre 1 si oui, et -1 si non. |
| 404 |
|
' on met 1 si les 2 startvertex sont au même endroit, -1 si ce n'est pas le cas |
| 405 |
|
|
| 406 |
< |
Dim a As SlyAreteVol = Nothing |
| 406 |
> |
Dim a As SuperArete = Nothing |
| 407 |
> |
Dim trouve As Boolean = False |
| 408 |
|
Dim som1 As SldWorks.Vertex, som2 As SldWorks.Vertex |
| 409 |
|
For Each a In Commun.lst_AreteVolume |
| 410 |
< |
If a.nom = NomMaitre Then Exit For |
| 410 |
> |
If a.nom = NomMaitre Then trouve = True : Exit For |
| 411 |
|
Next |
| 412 |
< |
som1 = Me.SwArete.GetStartVertex |
| 412 |
> |
|
| 413 |
> |
If Not trouve Then |
| 414 |
> |
For Each a In Commun.lst_AreteCoque |
| 415 |
> |
If a.nom = NomMaitre Then Exit For |
| 416 |
> |
Next |
| 417 |
> |
End If |
| 418 |
> |
|
| 419 |
> |
|
| 420 |
> |
som1 = Me.swArete.GetStartVertex |
| 421 |
|
If som1 IsNot Nothing Then |
| 422 |
|
som2 = a.swArete.GetStartVertex |
| 423 |
+ |
If som2 Is Nothing Then a.Colorer(4, 0.5, 0, 0.5) : Me.Colorer(4, 1, 0, 1) : MsgBox(a.nom & " " & Me.nom & "Comparer = " & Me.comparer(a.swArete)) |
| 424 |
|
If Distance(som1, som2) < Epsilon Then sens = 1 Else sens = -1 |
| 425 |
|
Else ' wouch!, si on a une courbe fermée, comment on trouve le sens de l'arête maitre comparé à l'arète esclave. |
| 426 |
|
' si les 2 arètes sont une par-dessus l'autre, alors je prend le point à t=0 et le T du point équivalent sur l'arète esclave |
| 430 |
|
Dim x, y, z, T2, T3 As Double |
| 431 |
|
Dim ret As Boolean = Me.Evaluer(0, x, y, z) |
| 432 |
|
T2 = a.GetT(x, y, z) |
| 371 |
– |
|
| 433 |
|
Me.Evaluer(0.1, x, y, z) |
| 434 |
|
T3 = a.GetT(x, y, z) |
| 435 |
|
If T3 = (T2 + 0.1) Then sens = 1 Else sens = -1 |
| 436 |
|
End If |
| 437 |
|
|
| 377 |
– |
|
| 378 |
– |
|
| 438 |
|
End If |
| 439 |
|
|
| 440 |
|
paramSens.SetDoubleValue2(sens, 2, "") |
| 441 |
|
ParamMaitre.SetStringValue2(NomMaitre, 2, "") ' swAllConfiguration = 2 |
| 442 |
< |
GererDossiers("Doublons", nom) |
| 442 |
> |
'GererDossiers("Doublons", nom) |
| 443 |
> |
|
| 444 |
> |
' Me.Colorer(2, 1, 1, 0) |
| 445 |
> |
|
| 446 |
> |
End Sub |
| 447 |
> |
|
| 448 |
> |
|
| 449 |
> |
''' <summary> |
| 450 |
> |
''' Met un attribut sur l'arête pour qu'elle soit ignorée |
| 451 |
> |
''' </summary> |
| 452 |
> |
''' <remarks></remarks> |
| 453 |
> |
Public Sub MettreAttributIgnorer() |
| 454 |
> |
Dim attr As sldworks.Attribute |
| 455 |
> |
Dim swEnt As sldworks.Entity |
| 456 |
> |
Dim nom As String = Nothing |
| 457 |
> |
Dim i As Integer |
| 458 |
> |
|
| 459 |
> |
swEnt = Me.swArete |
| 460 |
|
|
| 461 |
< |
'Me.Colorer(2, 1, 1, 0) |
| 461 |
> |
attr = swEnt.FindAttribute(Intersections.DefAttrIgnorer, 0) |
| 462 |
> |
|
| 463 |
> |
While attr Is Nothing |
| 464 |
> |
nom = "Ignorer" & CStr(i) |
| 465 |
> |
attr = Intersections.DefAttrIgnorer.CreateInstance5(swModel, swEnt, nom, 0, swconst.swInConfigurationOpts_e.swAllConfiguration) |
| 466 |
> |
i += 1 |
| 467 |
> |
End While |
| 468 |
|
|
| 469 |
|
End Sub |
| 470 |
|
|
| 481 |
|
attr.Delete(True) |
| 482 |
|
End Sub |
| 483 |
|
|
| 484 |
+ |
|
| 485 |
+ |
''' <summary> |
| 486 |
+ |
''' Retourne vrai si l'arête a un attribut pour ignorer |
| 487 |
+ |
''' </summary> |
| 488 |
+ |
''' <returns>Vrai si on doit ignorer l'arête</returns> |
| 489 |
+ |
''' <remarks></remarks> |
| 490 |
+ |
Public Function Ignorer() As Boolean |
| 491 |
+ |
Dim attr As sldworks.Attribute |
| 492 |
+ |
Dim swent As sldworks.Entity |
| 493 |
+ |
swent = Me.swArete |
| 494 |
+ |
attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0) |
| 495 |
+ |
If attr Is Nothing Then Return False Else Return True |
| 496 |
+ |
End Function |
| 497 |
+ |
|
| 498 |
|
''' <summary> |
| 499 |
|
''' Function qui retourne le nom qui est sur une arète |
| 500 |
|
''' </summary> |
| 510 |
|
''' <summary> |
| 511 |
|
''' Calcule et retourne le T au milieu de l'arète |
| 512 |
|
''' </summary> |
| 513 |
+ |
''' <param name="Reverse">Si oui, alors oon retourne le milieu de la courbe inversée. Le «milieu» n'est pas le même si on a une spline...</param> |
| 514 |
|
''' <returns>Le T du milieu</returns> |
| 515 |
|
''' <remarks></remarks> |
| 516 |
< |
Public Function GetTMilieu() As Double |
| 517 |
< |
Dim swCourbe As SldWorks.Curve |
| 516 |
> |
Public Function GetTMilieu(Optional ByVal Reverse As Boolean = False) As Double |
| 517 |
> |
Dim swCourbe As sldworks.Curve |
| 518 |
|
Dim temp As Object |
| 519 |
|
Dim T1 As Double, T2 As Double |
| 520 |
< |
Dim sommet As SldWorks.Vertex |
| 520 |
> |
Dim sommet As sldworks.Vertex |
| 521 |
|
Dim point As Object |
| 522 |
|
|
| 426 |
– |
swCourbe = Me.SwArete.GetCurve |
| 523 |
|
|
| 524 |
< |
sommet = Me.SwArete.GetStartVertex() |
| 524 |
> |
swCourbe = Me.swArete.GetCurve |
| 525 |
> |
If Reverse Then swCourbe = swCourbe.ReverseCurve() |
| 526 |
> |
|
| 527 |
> |
sommet = Me.swArete.GetStartVertex() |
| 528 |
|
|
| 529 |
|
If sommet IsNot Nothing Then |
| 530 |
|
point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T1 = temp(0) |
| 553 |
|
Dim retour(1) As Double |
| 554 |
|
retval = Me.SwArete.GetParameter(x, y, z) |
| 555 |
|
retour = retval |
| 556 |
< |
If Not retour(1) Then MsgBox("GetT n'a pas fonctionné pour cette arête.", MsgBoxStyle.Critical) |
| 556 |
> |
If Not retour(1) Then |
| 557 |
> |
Me.Colorer(2, 1, 0.5, 0) ' : Commun.MettreUnPoint(x, y, z) |
| 558 |
> |
Dim ret As Object = Me.swArete.GetClosestPointOn(x, y, z) |
| 559 |
> |
|
| 560 |
> |
Dim obj As Object = Me.swArete.GetClosestPointOn(x, y, z) |
| 561 |
> |
Dim ob() As Double = obj |
| 562 |
> |
retval = Me.swArete.GetParameter(ob(0), ob(1), ob(2)) |
| 563 |
> |
|
| 564 |
> |
End If |
| 565 |
|
Return retour(0) |
| 566 |
|
End Function |
| 567 |
|
|
| 685 |
|
|
| 686 |
|
If swArete Is sAreteTest Then Return True |
| 687 |
|
|
| 581 |
– |
' les conditions suivantes doivent toutes être vrai pour retourner oui.. |
| 582 |
– |
' 1 - les types sont les mêmes (lignes, cercles, bsplines...) |
| 583 |
– |
If Not Me.IsLine = sAreteTest.IsLine Then Return False |
| 584 |
– |
|
| 688 |
|
|
| 689 |
|
|
| 690 |
|
' 2 - les 2 points d'extrémités sont identiques. |
| 697 |
|
If debut1 Is Nothing And debut2 Is Nothing Then ' peut-être un cercle |
| 698 |
|
If Not swModel.ClosestDistance(sAreteTest.swArete, Me.swArete, Nothing, Nothing) < Epsilon Then Return False |
| 699 |
|
' bon, on a 2 cercles (ou courbe fermées) qui se touchent à au moins un point... |
| 700 |
< |
Dim courbe1 As SldWorks.Curve = Me.swArete.GetCurve |
| 701 |
< |
Dim courbe2 As SldWorks.Curve = sAreteTest.swArete.GetCurve |
| 700 |
> |
Dim courbe1 As sldworks.Curve = Me.swArete.GetCurve |
| 701 |
> |
Dim courbe2 As sldworks.Curve = sAreteTest.swCourbe |
| 702 |
|
|
| 703 |
< |
If courbe1.IsCircle AndAlso courbe2.IsCircle Then |
| 703 |
> |
If Me.IsCircle AndAlso sAreteTest.IsCircle Then |
| 704 |
|
Dim vparam1 As Object = courbe1.CircleParams() |
| 705 |
|
Dim vparam2 As Object = courbe2.CircleParams() |
| 706 |
< |
If Math.Abs(vparam1(0) - vparam2(0)) < Epsilon AndAlso Math.Abs(vparam1(1) - vparam2(1)) < Epsilon AndAlso Math.Abs(vparam1(2) - vparam2(2)) < Epsilon AndAlso Math.Abs(vparam1(6) - vparam2(6)) < Epsilon Then Return True Else Return False ' centreX , y , z , Radius(6) |
| 707 |
< |
ElseIf courbe1.IsEllipse AndAlso courbe1.IsEllipse Then |
| 706 |
> |
If Math.Abs(vparam1(0) - vparam2(0)) < 1000 * Epsilon AndAlso Math.Abs(vparam1(1) - vparam2(1)) < 1000 * Epsilon AndAlso Math.Abs(vparam1(2) - vparam2(2)) < 1000 * Epsilon AndAlso Math.Abs(vparam1(6) - vparam2(6)) < 1000 * Epsilon Then |
| 707 |
> |
Dim tmilieuC As Double = Me.GetTMilieu |
| 708 |
> |
Dim xyzC() As Double = Nothing |
| 709 |
> |
If Not Me.Evaluer(tmilieuC, xyzC) Then MsgBox("Marche pas ici...") ' alors prendre ce qu'il y a en commentaire plus haut.... |
| 710 |
> |
Dim vPointC As Object = sAreteTest.swArete.GetClosestPointOn(xyzC(0), xyzC(1), xyzC(2)) |
| 711 |
> |
If Distance(xyzC(0), xyzC(1), xyzC(2), vPointC(0), vPointC(1), vPointC(2)) < 0.000001 Then Return True Else Return False |
| 712 |
> |
Else |
| 713 |
> |
Return False |
| 714 |
> |
End If |
| 715 |
> |
|
| 716 |
> |
ElseIf Me.IsEllipse AndAlso sAreteTest.IsEllipse Then |
| 717 |
|
Dim vparam1 As Object = courbe1.GetEllipseParams() |
| 718 |
|
Dim vparam2 As Object = courbe2.GetEllipseParams() |
| 719 |
|
For i As Integer = 0 To 10 |
| 720 |
< |
If Math.Abs(vparam1(i) - vparam2(i)) > Epsilon Then Return False |
| 720 |
> |
If Math.Abs(vparam1(i) - vparam2(i)) > 1000 * Epsilon Then Return False |
| 721 |
|
Next |
| 722 |
|
Return True |
| 723 |
< |
Else |
| 724 |
< |
Return False |
| 723 |
> |
Else ' peut-être des splines fermées... |
| 724 |
> |
' on fait un test sur ... ? 20 points ? ... sur une des 2 courbes, et si le point appartient à l'autre courbe aussi on retourne true |
| 725 |
> |
' la courbe Originale est me.swArete |
| 726 |
> |
Dim g As Integer = 0 |
| 727 |
> |
Dim pointTest(2) As Double |
| 728 |
> |
Dim Tmin As Double = Me.GetTMin |
| 729 |
> |
Dim Tmax As Double = Me.GetTMax |
| 730 |
> |
Dim incrT As Double = (Tmax - Tmin) / 20 |
| 731 |
> |
|
| 732 |
> |
|
| 733 |
> |
While g < 20 |
| 734 |
> |
Me.Evaluer(Tmin + g * incrT, pointTest) |
| 735 |
> |
If Commun.Distance(sAreteTest.swArete, pointTest) > 0.000001 Then Return False ' merde, je déteste cette façon de procéder! |
| 736 |
> |
g += 1 |
| 737 |
> |
End While |
| 738 |
> |
|
| 739 |
> |
|
| 740 |
> |
Return True |
| 741 |
|
End If |
| 742 |
< |
End If |
| 742 |
> |
End If |
| 743 |
> |
|
| 744 |
> |
If Distance(debut1, debut2) > 1000 * Epsilon AndAlso Distance(debut1, fin2) > 1000 * Epsilon Then Return False |
| 745 |
> |
If Distance(fin1, debut2) > 1000 * Epsilon AndAlso Distance(fin1, fin2) > 1000 * Epsilon Then Return False |
| 746 |
> |
|
| 747 |
> |
' update, le point milieu ne marche pas toujours.., mais si on a une ligne, innutile de tester plus loin |
| 748 |
> |
If Me.IsLine And sAreteTest.IsLine Then Return True |
| 749 |
> |
|
| 750 |
> |
|
| 751 |
> |
|
| 752 |
> |
'Dim D1() As Double = Me.GetTangenceDepart() |
| 753 |
> |
'Dim A1() As Double = Me.GetTangenceArivee() |
| 754 |
> |
|
| 755 |
> |
'Dim D2() As Double = sAreteTest.GetTangenceDepart |
| 756 |
> |
'Dim A2() As Double = sAreteTest.GetTangenceArivee |
| 757 |
> |
|
| 758 |
> |
|
| 759 |
> |
'If Distance(debut1, debut2) < 1000 * Epsilon Then ' courbes dans même sens |
| 760 |
> |
|
| 761 |
> |
' If Outils_Math.ComparerVecteurs3D(D1, D2) AndAlso Outils_Math.ComparerVecteurs3D(A1, A2) Then Return True Else Return False |
| 762 |
> |
'Else ' courbes dans sens différent |
| 763 |
> |
' Dim P1(2) As Double |
| 764 |
> |
' Dim P2(2) As Double |
| 765 |
> |
' If Outils_Math.ComparerVecteurs3D(D1, A2) = 1 AndAlso Outils_Math.ComparerVecteurs3D(A1, D2) = 1 Then Return True Else Return False |
| 766 |
> |
'End If |
| 767 |
> |
|
| 768 |
> |
|
| 769 |
> |
' une autre stratégie |
| 770 |
> |
Dim tmilieu As Double = Me.GetTMilieu |
| 771 |
> |
Dim xyz() As Double = Nothing |
| 772 |
> |
If Not Me.Evaluer(tmilieu, xyz) Then MsgBox("Marche pas ici...") ' alors prendre ce qu'il y a en commentaire plus haut.... |
| 773 |
> |
Dim vPoint As Object = sAreteTest.swArete.GetClosestPointOn(xyz(0), xyz(1), xyz(2)) |
| 774 |
> |
If Distance(xyz(0), xyz(1), xyz(2), vPoint(0), vPoint(1), vPoint(2)) < 0.000001 Then Return True Else Return False |
| 775 |
|
|
| 616 |
– |
If Distance(debut1, debut2) > Epsilon AndAlso Distance(debut1, fin2) > Epsilon Then Return False |
| 617 |
– |
If Distance(fin1, debut2) > Epsilon AndAlso Distance(fin1, fin2) > Epsilon Then Return False |
| 776 |
|
|
| 619 |
– |
' le pointmilieu est identique |
| 620 |
– |
Dim Milieu1() As Double = Me.GetPointMilieu() |
| 621 |
– |
Dim milieu2() As Double = sAreteTest.GetPointMilieu |
| 622 |
– |
If Distance(Milieu1, milieu2) > Epsilon Then Return False |
| 777 |
|
|
| 624 |
– |
Return True ' pourrait ne pas marcher dans certains cas fucké... |
| 778 |
|
End Function |
| 779 |
|
|
| 780 |
+ |
|
| 781 |
|
''' <summary> |
| 782 |
< |
''' Function qui calcule la longueur de l'arète |
| 782 |
> |
''' DOnne la longueur d'une arète |
| 783 |
|
''' </summary> |
| 784 |
< |
''' <returns>La longueur de l'arrète</returns> |
| 784 |
> |
''' <value></value> |
| 785 |
> |
''' <returns>La longueur de l'arète</returns> |
| 786 |
|
''' <remarks></remarks> |
| 787 |
< |
Public Function Longueur() As Double |
| 788 |
< |
Dim temp As Object |
| 789 |
< |
Dim T1 As Double, T2 As Double |
| 790 |
< |
Dim sommet As SldWorks.Vertex |
| 791 |
< |
Dim point As Object |
| 787 |
> |
Public ReadOnly Property Longueur() As Double |
| 788 |
> |
Get |
| 789 |
> |
Dim temp As Object |
| 790 |
> |
Dim T1 As Double, T2 As Double |
| 791 |
> |
Dim sommet As sldworks.Vertex |
| 792 |
> |
Dim point As Object |
| 793 |
|
|
| 794 |
< |
sommet = swArete.GetStartVertex() |
| 794 |
> |
sommet = swArete.GetStartVertex() |
| 795 |
|
|
| 796 |
< |
If sommet IsNot Nothing Then |
| 797 |
< |
point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T1 = temp(0) |
| 798 |
< |
sommet = swArete.GetEndVertex() : point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T2 = temp(0) |
| 799 |
< |
Return swCourbe.GetLength2(T1, T2) |
| 796 |
> |
If sommet IsNot Nothing Then |
| 797 |
> |
point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T1 = temp(0) |
| 798 |
> |
sommet = swArete.GetEndVertex() : point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T2 = temp(0) |
| 799 |
> |
Return swCourbe.GetLength2(T1, T2) |
| 800 |
|
|
| 801 |
< |
Else |
| 802 |
< |
'l'arète est fermée. |
| 803 |
< |
Dim params() As Double |
| 804 |
< |
If swCourbe.IsCircle Then |
| 805 |
< |
params = swCourbe.CircleParams |
| 806 |
< |
Return params(7) * Pi * 2 |
| 801 |
> |
Else |
| 802 |
> |
'l'arète est fermée. |
| 803 |
> |
Dim params() As Double |
| 804 |
> |
If swCourbe.IsCircle Then |
| 805 |
> |
params = swCourbe.CircleParams |
| 806 |
> |
Return params(6) * Pi * 2 |
| 807 |
> |
End If |
| 808 |
> |
MsgBox("On demande la longueur d'une courbe fermée qui n'est pas un cercle... ce n'est pas encore programmé car ça ne devrait pas arriver." & vbCr & " On pourrait prendre la tessellation, mais là on aurait une approximation!") |
| 809 |
|
End If |
| 810 |
< |
MsgBox("On demande la longueur d'une courbe fermée qui n'est pas un cercle... ce n'est pas encore programmé car ça ne devrait pas arriver.") |
| 811 |
< |
End If |
| 812 |
< |
End Function |
| 810 |
> |
End Get |
| 811 |
> |
End Property |
| 812 |
> |
|
| 813 |
> |
''' <summary> |
| 814 |
> |
''' Si la courbe est un cercle, retourne le rayon. |
| 815 |
> |
''' </summary> |
| 816 |
> |
''' <value></value> |
| 817 |
> |
''' <returns></returns> |
| 818 |
> |
''' <remarks></remarks> |
| 819 |
> |
Public ReadOnly Property Rayon() As Double |
| 820 |
> |
Get |
| 821 |
> |
'MsgBox("Mettre du code ici") |
| 822 |
> |
Dim swCurve As sldworks.Curve = Me.swArete.GetCurve |
| 823 |
> |
|
| 824 |
> |
|
| 825 |
> |
If Me.IsCircle Then |
| 826 |
> |
Dim obj As Object = swCurve.CircleParams() |
| 827 |
> |
Return obj(6) |
| 828 |
> |
Else : Return (Nothing) |
| 829 |
> |
End If |
| 830 |
> |
|
| 831 |
> |
End Get |
| 832 |
> |
End Property |
| 833 |
> |
|
| 834 |
|
|
| 835 |
|
''' <summary> |
| 836 |
|
''' Renvoie les coordonnées du point de départ |
| 838 |
|
''' <returns></returns> |
| 839 |
|
''' <remarks></remarks> |
| 840 |
|
Public Function GetStartPoint() As Double() |
| 841 |
< |
Dim swSommet As SldWorks.Vertex |
| 841 |
> |
Dim swSommet As sldworks.Vertex |
| 842 |
|
Dim retval As Object |
| 843 |
|
Dim xyz(2) As Double |
| 844 |
< |
swSommet = Me.SwArete.GetStartVertex() |
| 844 |
> |
swSommet = Me.swArete.GetStartVertex() |
| 845 |
|
If swSommet Is Nothing Then Return Nothing |
| 846 |
|
retval = swSommet.GetPoint() |
| 847 |
|
xyz = retval |
| 854 |
|
''' <returns>Faux si le sommet n'esiste pas</returns> |
| 855 |
|
''' <remarks></remarks> |
| 856 |
|
Public Function GetStartPoint(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Boolean |
| 857 |
< |
Dim swSommet As SldWorks.Vertex |
| 857 |
> |
Dim swSommet As sldworks.Vertex |
| 858 |
|
Dim retval As Object |
| 859 |
|
Dim xyz(2) As Double |
| 860 |
< |
swSommet = Me.SwArete.GetStartVertex() |
| 860 |
> |
swSommet = Me.swArete.GetStartVertex() |
| 861 |
|
If swSommet Is Nothing Then Return False |
| 862 |
|
retval = swSommet.GetPoint() |
| 863 |
|
x = retval(0) |
| 867 |
|
End Function |
| 868 |
|
|
| 869 |
|
Public Function GetEndPoint() As Double() |
| 870 |
< |
Dim swSommet As SldWorks.Vertex |
| 870 |
> |
Dim swSommet As sldworks.Vertex |
| 871 |
|
Dim retval As Object |
| 872 |
|
Dim xyz(2) As Double |
| 873 |
< |
swSommet = Me.SwArete.GetEndVertex() |
| 873 |
> |
swSommet = Me.swArete.GetEndVertex() |
| 874 |
|
If swSommet Is Nothing Then Return Nothing |
| 875 |
|
retval = swSommet.GetPoint() |
| 876 |
|
xyz = retval |
| 883 |
|
''' <returns>Faux si le sommet n'esiste pas</returns> |
| 884 |
|
''' <remarks></remarks> |
| 885 |
|
Public Function GetEndPoint(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Boolean |
| 886 |
< |
Dim swSommet As SldWorks.Vertex |
| 886 |
> |
Dim swSommet As sldworks.Vertex |
| 887 |
|
Dim retval As Object |
| 888 |
|
Dim xyz(2) As Double |
| 889 |
< |
swSommet = Me.SwArete.GetEndVertex() |
| 889 |
> |
swSommet = Me.swArete.GetEndVertex() |
| 890 |
|
If swSommet Is Nothing Then Return False |
| 891 |
|
retval = swSommet.GetPoint() |
| 892 |
|
x = retval(0) |
| 898 |
|
|
| 899 |
|
|
| 900 |
|
|
| 901 |
+ |
''' <summary> |
| 902 |
+ |
''' Retourne un tableau de 3 doubles représentant le vecteur de tangence au point de départ de la courbe |
| 903 |
+ |
''' </summary> |
| 904 |
+ |
''' <returns>La tangence de la courbe</returns> |
| 905 |
+ |
''' <remarks></remarks> |
| 906 |
+ |
Public Function GetTangenceDepart() As Double() |
| 907 |
+ |
Dim s1 As sldworks.Vertex = Me.SommetDebut |
| 908 |
+ |
Dim es1 As New SuperSommet(s1, True) |
| 909 |
+ |
Dim T As Double = Me.GetTMin |
| 910 |
+ |
|
| 911 |
+ |
Dim tan(2) As Double |
| 912 |
+ |
Me.Evaluer(T + 100 * Epsilon, tan) |
| 913 |
+ |
tan(0) = es1.X - tan(0) |
| 914 |
+ |
tan(1) = es1.Y - tan(1) |
| 915 |
+ |
tan(2) = es1.Z - tan(2) |
| 916 |
+ |
|
| 917 |
+ |
Return Outils_Math.unitaire(tan) |
| 918 |
+ |
|
| 919 |
+ |
'Dim swCourbe As sldworks.Curve = Me.swArete.GetCurve |
| 920 |
+ |
'Dim vTangent As Object = swCourbe.Evaluate(Me.GetTMin) |
| 921 |
+ |
''[ PointX, PointY, PointZ, TangentX, TangentY, TangentZ, Success ] |
| 922 |
+ |
'Dim dTangent(2) As Double |
| 923 |
+ |
'dTangent(0) = vTangent(3) : dTangent(1) = vTangent(4) : dTangent(2) = vTangent(5) |
| 924 |
+ |
'Return dTangent |
| 925 |
+ |
End Function |
| 926 |
+ |
|
| 927 |
+ |
''' <summary> |
| 928 |
+ |
''' Retourne un tableau de 3 doubles représentant le vecteur de tangence au point de fin de la courbe |
| 929 |
+ |
''' </summary> |
| 930 |
+ |
''' <returns>La tangence de la courbe</returns> |
| 931 |
+ |
''' <remarks></remarks> |
| 932 |
+ |
Public Function GetTangenceArivee() As Double() |
| 933 |
+ |
Dim s1 As sldworks.Vertex = Me.SommetFinal |
| 934 |
+ |
Dim es1 As New SuperSommet(s1, True) |
| 935 |
+ |
Dim T As Double = Me.GetTMax |
| 936 |
+ |
|
| 937 |
+ |
Dim tan(2) As Double |
| 938 |
+ |
Me.Evaluer(T - 100 * Epsilon, tan) |
| 939 |
+ |
tan(0) = es1.X - tan(0) |
| 940 |
+ |
tan(1) = es1.Y - tan(1) |
| 941 |
+ |
tan(2) = es1.Z - tan(2) |
| 942 |
+ |
|
| 943 |
+ |
Return Outils_Math.unitaire(tan) |
| 944 |
+ |
|
| 945 |
+ |
End Function |
| 946 |
|
|
| 947 |
+ |
''' <summary> |
| 948 |
+ |
''' Retourne un tableau de 3 doubles représentant le vecteur de tangence au point de fin de la courbe |
| 949 |
+ |
''' </summary> |
| 950 |
+ |
''' <param name="T">La valuer de T à laquelle on cherche la tangence</param> |
| 951 |
+ |
''' <returns>La tangence de la courbe</returns> |
| 952 |
+ |
''' <remarks></remarks> |
| 953 |
+ |
Public Function GetTangence(ByVal T As Double) As Double() |
| 954 |
+ |
Dim s1 As sldworks.Vertex = Me.SommetFinal |
| 955 |
+ |
Dim es1 As New SuperSommet(s1, True) |
| 956 |
|
|
| 957 |
+ |
Dim tan(2) As Double |
| 958 |
+ |
Me.Evaluer(T, tan) |
| 959 |
+ |
tan(0) = es1.X - tan(0) |
| 960 |
+ |
tan(1) = es1.Y - tan(1) |
| 961 |
+ |
tan(2) = es1.Z - tan(2) |
| 962 |
|
|
| 963 |
+ |
Return Outils_Math.unitaire(tan) |
| 964 |
|
|
| 965 |
+ |
End Function |
| 966 |
|
|
| 967 |
|
|
| 968 |
+ |
''' <summary> |
| 969 |
+ |
''' Retourne le premier sommet de la courbe |
| 970 |
+ |
''' </summary> |
| 971 |
+ |
''' <value></value> |
| 972 |
+ |
''' <returns></returns> |
| 973 |
+ |
''' <remarks></remarks> |
| 974 |
+ |
Public ReadOnly Property SommetDebut() As sldworks.Vertex |
| 975 |
+ |
Get |
| 976 |
+ |
Return Me.swArete.GetStartVertex |
| 977 |
+ |
End Get |
| 978 |
+ |
End Property |
| 979 |
+ |
|
| 980 |
+ |
''' <summary> |
| 981 |
+ |
''' Retourne le dernier sommet de la courbe |
| 982 |
+ |
''' </summary> |
| 983 |
+ |
''' <value></value> |
| 984 |
+ |
''' <returns></returns> |
| 985 |
+ |
''' <remarks></remarks> |
| 986 |
+ |
Public ReadOnly Property SommetFinal() As sldworks.Vertex |
| 987 |
+ |
Get |
| 988 |
+ |
Return Me.swArete.GetEndVertex |
| 989 |
+ |
End Get |
| 990 |
+ |
End Property |
| 991 |
+ |
|
| 992 |
+ |
|
| 993 |
+ |
''' <summary> |
| 994 |
+ |
''' Sub utilisée pour le débuggage qui met 100 points sur la courbe |
| 995 |
+ |
''' </summary> |
| 996 |
+ |
''' <remarks>POur évaluer la tolérance</remarks> |
| 997 |
+ |
Public Sub RemplirDePoints() |
| 998 |
+ |
Dim T As Double, Tmin As Double, Tmax As Double, Tinc As Double |
| 999 |
+ |
Dim P(2) As Double |
| 1000 |
+ |
swModel.Insert3DSketch2(False) |
| 1001 |
+ |
|
| 1002 |
+ |
Tmin = Me.GetTMin |
| 1003 |
+ |
Tmax = Me.GetTMax |
| 1004 |
+ |
Tinc = (Tmax - Tmin) / 100 |
| 1005 |
+ |
T = Tmin |
| 1006 |
+ |
|
| 1007 |
+ |
For i As Integer = 0 To 100 |
| 1008 |
+ |
T += Tinc |
| 1009 |
+ |
Me.Evaluer(T, P) |
| 1010 |
+ |
swModel.CreatePoint2(P(0), P(1), P(2)) |
| 1011 |
+ |
Next i |
| 1012 |
+ |
|
| 1013 |
+ |
swModel.Insert3DSketch2(False) |
| 1014 |
+ |
End Sub |
| 1015 |
|
|
| 1016 |
|
|
| 1017 |
+ |
''' <summary> |
| 1018 |
+ |
''' Sélectionne l'arète, mais s'assure de ne pas la désélectionner si elle est déjà sélectionnée |
| 1019 |
+ |
''' </summary> |
| 1020 |
+ |
''' <remarks>Pas très rapide...</remarks> |
| 1021 |
+ |
Public Sub SelectionnerSafe() |
| 1022 |
+ |
Dim swEnt As sldworks.Entity = Me.swArete |
| 1023 |
+ |
Dim selMgr As sldworks.SelectionMgr = swModel.SelectionManager |
| 1024 |
+ |
|
| 1025 |
+ |
For i As Integer = 1 To selMgr.GetSelectedObjectCount2(-1) |
| 1026 |
+ |
If selMgr.GetSelectedObject6(i, -1) Is swEnt Then |
| 1027 |
+ |
Exit Sub |
| 1028 |
+ |
End If |
| 1029 |
+ |
Next |
| 1030 |
+ |
|
| 1031 |
+ |
swEnt.Select4(True, Nothing) |
| 1032 |
+ |
End Sub |
| 1033 |
+ |
|
| 1034 |
+ |
|
| 1035 |
+ |
Public Sub PasserLes2FacesAdjascentes(ByRef swFace1 As sldworks.Face2, ByRef swFace2 As sldworks.Face2) |
| 1036 |
+ |
Dim obj As Object = Me.swArete.GetTwoAdjacentFaces2() |
| 1037 |
+ |
swFace1 = obj(0) |
| 1038 |
+ |
swFace2 = obj(1) |
| 1039 |
+ |
End Sub |
| 1040 |
|
|
| 1041 |
|
End Class |
