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

Comparing magicsld/SuperFace.vb (file contents):
Revision 40 by bournival, Mon Aug 20 21:30:28 2007 UTC vs.
Revision 130 by bournival, Wed Jul 30 21:26:03 2008 UTC

# Line 1 | Line 1
1 <
1 > Imports SolidWorks.Interop
2 > Imports SolidWorks.Interop.swconst
3 > Imports SolidWorks.Interop.swpublished
4  
5   Public Class SuperFace
6      Inherits SuperEntite
# Line 40 | Line 42 | Public Class SuperFace
42      ''' <param name="Face"></param>
43      ''' <param name="encapsulateur"></param>
44      ''' <remarks></remarks>
45 <    Public Sub New(ByRef Face As SldWorks.Face2, ByRef encapsulateur As Boolean)
45 >    Public Sub New(ByRef Face As sldworks.Face2, ByRef encapsulateur As Boolean)
46          lst_Faces.Add(Face)
47      End Sub
48  
49 <    Friend Sub New(ByRef face As SldWorks.Face2, Optional ByVal tip As Integer = 0)
49 >    Friend Sub New(ByRef face As sldworks.Face2, Optional ByVal tip As Integer = 0)
50          Me.AjouterFace(face)
51          Select Case tip
52              Case Commun.tipe_e.Volume
# Line 57 | Line 59 | Public Class SuperFace
59      End Sub
60  
61  
62 <    Friend Overridable Function UpdateApresSplit(ByRef inter As InterPoutreCoque, ByRef poutre As SlyAretePoutre, ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef Plan As SldWorks.RefPlane, Optional ByRef FI As Boolean = False) As SldWorks.Face2
63 <        MsgBox("La fonction non overridée a été appelée!")
64 <        Return Nothing
65 <    End Function
62 >    'Friend Overridable Function UpdateApresSplit(ByRef inter As InterPoutreCoque, ByRef poutre As SlyAretePoutre, ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef Plan As SldWorks.RefPlane, Optional ByRef FI As Boolean = False) As SldWorks.Face2
63 >    '    MsgBox("La fonction non overridée a été appelée!")
64 >    '    Return Nothing
65 >    'End Function
66  
67 <    Friend Overridable Function UpdateApresSplit(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre, ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef Plan As SldWorks.RefPlane, Optional ByRef FI As Boolean = False) As SldWorks.Face2
68 <        MsgBox("La fonction non overridée a été appelée!")
69 <        Return Nothing
70 <    End Function
67 >    'Friend Overridable Function UpdateApresSplit(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre, ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef Plan As SldWorks.RefPlane, Optional ByRef FI As Boolean = False) As SldWorks.Face2
68 >    '    MsgBox("La fonction non overridée a été appelée!")
69 >    '    Return Nothing
70 >    'End Function
71  
72      ''' <summary>
73 <    ''' Sub qui ajoute des mini-poutres à la section entre le sommet de la poutre et un point de la face interne
73 >    ''' Sub qui ajoute des mini-poutres à la section entre le sommet de la poutre et un point de la face interne quand la face interne ne touche pas à la poutre
74      ''' </summary>
75      ''' <param name="poutre">La poutre principale</param>
76      ''' <param name="FaceInterne">La face où il faut ajouter UNE mini-poutre</param>
# Line 93 | Line 95 | Public Class SuperFace
95          swArete = FaceInterne.GetFirstLoop.GetFirstCoEdge.getedge
96          swSommet2 = swArete.GetStartVertex()
97  
98 <        If swSommet2 Is Nothing Then ' un celcle (ou ellipse)
98 >        If swSommet2 Is Nothing Then ' un cercle (ou ellipse)
99              Dim retval As Object
100              retval = swArete.Evaluate(0) ' il va y avor un LC point anyway...
101              x2 = retval(0)
# Line 112 | Line 114 | Public Class SuperFace
114          '  3 faire une mini-poutre entre les 2
115  
116          swModel.Insert3DSketch2(True)
115 –        swModel.CreateLine2(x1, y1, z1, x2, y2, z2)
117          swSketch = swModel.GetActiveSketch2()
118 +        If swSketch Is Nothing Then swModel.Insert3DSketch2(True) : swSketch = swModel.GetActiveSketch2()
119 +        If swSketch Is Nothing Then MsgBox("Ça merde vraiment...")
120 +        swModel.CreateLine2(x1, y1, z1, x2, y2, z2)
121          swModel.Insert3DSketch2(True)
122          swEnt = swSketch : swEnt.Select2(False, 1)
123          swModel.InsertCompositeCurve()
# Line 392 | Line 396 | Public Class SuperFace
396      End Sub
397  
398  
399 <    ' sub qui découpe les bords de la face.
396 <    Friend Sub CoupeCote(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre)
397 <        Dim pt3() As Double, pt3Original() As Double
398 <        Dim base(2) As Double, baseOriginal(2) As Double
399 <        Dim swEnt As SldWorks.Entity
400 <        Dim Directionnel As Boolean, Flip As Boolean
401 <        Dim planReference As SldWorks.RefPlane = Nothing
402 <        Dim sketchline As SldWorks.SketchSegment
403 <        Dim swSketch As SldWorks.Sketch
404 <        Dim DemiLargeur As Double
405 <        Dim g As Integer
406 <        Dim Face(1) As SldWorks.Face2
407 <        Dim PlanEntity As SldWorks.Entity = Nothing
408 <        Dim r(2) As Double
409 <        Dim sk(1) As Double
410 <        pt3Original = poutre.GetPoint3
411 <
412 <
413 <        swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
414 <        'swModel.SetAddToDB(True)
415 <        'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
416 <
417 <        Dim vArete As Object
418 <        Dim cut As Double
419 <
420 <        If Me.estPlan Then
421 <            ' la coque est plane, on met une esquisse dessus.#
422 <            PlanEntity = Me.SwFace
423 <
424 <        ElseIf Me.estCylindre Then
425 <            ' on doit créer un plan de référence...
426 <
427 <        ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
428 <            Dim vEdge As Object
429 <            Dim i As Integer
430 <            Dim swArete2() As SldWorks.Edge
431 <            Dim swSommet As SldWorks.Vertex
432 <
433 <            vEdge = Me.SwFace.GetEdges
434 <            swArete2 = vEdge
435 <            swModel.ClearSelection2(True)
436 <
437 <            While planReference Is Nothing
438 <                If UBound(swArete2) - 2 < i Then MsgBox("Dans CoupeLong, problème pour créer un plan avec 3 points.  (La face est un FauxPlan)", MsgBoxStyle.Critical, "Le plan ne sera pas créé") : Exit While
439 <                swSommet = swArete2(i).GetStartVertex()
440 <                swEnt = swSommet
441 <                swEnt.Select4(False, Nothing)
442 <                swArete2(i + 1).GetStartVertex()
443 <                swEnt = swSommet
444 <                swEnt.Select4(True, Nothing)
445 <                swArete2(i + 2).GetStartVertex()
446 <                swEnt = swSommet
447 <                swEnt.Select4(True, Nothing)
448 <                i += 1
449 <                planReference = swModel.CreatePlaneThru3Points3(False)
450 <                PlanEntity = planReference
451 <            End While
452 <
453 <
454 <        Else ' la face est une spline
455 <            MsgBox("Dans coupeCoté, la face est un type de surface qui n'est pas encore traité")
456 <        End If
457 <
458 <
459 <        baseOriginal(0) = inter.x : baseOriginal(1) = inter.y : baseOriginal(2) = inter.z
460 <
461 <
462 <        Dim Psi As Double
463 <        Dim u(2) As Double, v(2) As Double, usketch(2) As Double, vsketch(2) As Double
464 <        Dim Arete As SldWorks.Edge = Nothing
465 <        Dim retval As Object
466 <        u = poutre.GetOrientation(inter.x, inter.y, inter.z)
467 <
468 <
469 <        vArete = Me.SwFace.GetEdges
470 <
471 <        For Each Arete In vArete
472 <            If Commun.Distance(Arete, inter.x, inter.y, inter.z) < Epsilon Then Exit For
473 <        Next
474 <
475 <        retval = Arete.GetClosestPointOn(inter.x, inter.y, inter.z)
476 <        retval = Arete.Evaluate(retval(3))
477 <        v(0) = retval(3) : v(1) = retval(4) : v(2) = retval(5)
478 <
479 <
480 <
481 <
482 <        For g = 0 To 1
483 <
484 <            PlanEntity.Select(False)
485 <            swModel.InsertSketch2(True)
486 <            swSketch = swModel.GetActiveSketch2
487 <
488 <            pt3 = Commun.TransfertModelSketch(swSketch, pt3Original)
489 <            usketch = Commun.TransfertModelSketch(swSketch, u)  ' on les met dans le plan du sketch
490 <            vsketch = Commun.TransfertModelSketch(swSketch, v)
491 <            base = Commun.TransfertModelSketch(swSketch, baseOriginal)
492 <            Psi = Outils_Math.cosdir(usketch, vsketch)
493 <
494 <            Dim a As Double, b As Double
495 <            'longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
496 <            'If pt3(1) = 0 Then a = 999999999999 Else a = Math.Abs(poutre.GetD2() * longueur / pt3(1))
497 <            'If pt3(0) = 0 Then b = 999999999999 Else b = Math.Abs(poutre.GetD1() * longueur / pt3(0))
498 <            ' À revoir. Si le plan est un cylindre ça marche plus. sans compter l'épaisseur de la poutre.
499 <            ' pour l'instant je prend la plus prtite valeur...
500 <            a = poutre.GetD1
501 <            b = poutre.GetD2
502 <            DemiLargeur = Math.Min(a, b)
503 <            cut = DemiLargeur / Math.Sin(Pi / 2 - Psi)
504 <
505 <
506 <            Dim P1(1) As Double
507 <            Dim P2(1) As Double
508 <            Dim P3(1) As Double
509 <            Dim P4(1) As Double
510 <            Dim Ptest(2) As Double
511 <
512 <
513 <            If g = 0 Then
514 <                P1(0) = -cut
515 <                P1(1) = -cut '* mult ' 0
516 <                P2(0) = 0
517 <                P2(1) = -cut '* mult ' 0
518 <                P3(0) = 0
519 <                P3(1) = cut   'Intersections.Taille mult
520 <                P4(0) = -cut
521 <                P4(1) = cut   'Intersections.Taille mult
522 <                sk(0) = -Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
523 <
524 <            Else
525 <                P1(0) = 0
526 <                P1(1) = -cut '* mult '0
527 <                P2(0) = +cut
528 <                P2(1) = -cut '* mult '0
529 <                P3(0) = +cut
530 <                P3(1) = cut  'Intersections.Taille mult
531 <                P4(0) = 0
532 <                P4(1) = cut  'Intersections.Taille mult
533 <                sk(0) = Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
534 <
535 <            End If
536 <
537 <            P1 = Outils_Math.Rotation2D(vsketch, P1)
538 <            P2 = Outils_Math.Rotation2D(vsketch, P2)
539 <            P3 = Outils_Math.Rotation2D(vsketch, P3)
540 <            P4 = Outils_Math.Rotation2D(vsketch, P4)
541 <            sk = Outils_Math.Rotation2D(vsketch, sk)
542 <
543 <            sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P2(0) + base(0), P2(1) + base(1), 0)
544 <            sketchline = swModel.CreateLine2(P2(0) + base(0), P2(1) + base(1), 0, P3(0) + base(0), P3(1) + base(1), 0)
545 <            sketchline = swModel.CreateLine2(P3(0) + base(0), P3(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)
546 <            sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)
547 <
548 <            swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
549 <            swModel.ClearSelection2(True)
550 <            swEnt = Me.SwFace : swEnt.Select2(False, 1)
551 <            swEnt = swSketch : swEnt.Select2(True, 4)
552 <
553 <            swModel.InsertSplitLineProject(Directionnel, Flip)
554 <            r = Commun.TransfertSketchToModel(swSketch, sk)
555 <            Face(g) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference)
556 <            'If Face(g) Is Nothing Then
557 <            'swSketch.Select(False)
558 <            'swModel.EditDelete()
559 <            'End If
560 <
561 <        Next g
562 <
563 <
564 <
565 <        ' mettre les mini-poutres
566 <        Dim vEdge2 As Object
567 <        Dim swArete As SldWorks.Edge
568 <        Dim vPoint As Object
569 <        Dim Mini1 As SldWorks.Edge = Nothing, Mini2 As SldWorks.Edge = Nothing
570 <
571 <
572 <        ' 1 - trouver les 2 arrères dont l'orientation est la même (ou l'inverse) que le v
573 <        For g = 0 To 1
574 <            If Not Face(g) Is Nothing Then
575 <                vEdge2 = Face(g).GetEdges()
576 <
577 <
578 <                ' construire u
579 <                For Each swArete In vEdge2
580 <                    If Commun.Distance(swArete, inter.x, inter.y, inter.z) < Epsilon Then
581 <                        ' l'arête touche à l'intersection,
582 <                        vPoint = swArete.GetClosestPointOn(inter.x, inter.y, inter.z)
583 <                        vPoint = swArete.Evaluate(vPoint(3))
584 <                        u(0) = vPoint(3) : u(1) = vPoint(4) : u(2) = vPoint(5)
585 <
586 <                        If Outils_Math.CompareSens(v, u) Then
587 <                            ' l'arète doit être une mini-poutre
588 <                            If Mini1 Is Nothing Then Mini1 = swArete : Exit For Else Mini2 = swArete : Exit For
589 <                        End If
590 <                    End If
591 <
592 <                Next
593 <
594 <            End If
595 <        Next
596 <
597 <        swEnt = Mini1
598 <        If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
599 <
600 <        If Not Mini2 Is Nothing Then
601 <            swEnt = Mini2
602 <            If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
603 <        End If
604 <
605 <        swModel.SetInferenceMode(True) '
606 <        'swModel.SetAddToDB(False)
607 <        'swModel.SetDisplayWhenAdded(True) '
608 <    End Sub
399 >    
400  
401  
402      ' sub qui coupe la face avec une arète qui repose dessus.
403      Friend Sub CoupeLong(ByRef inter As InterPoutreVolume, ByVal poutre As SlyAretePoutre)
613 –        Dim swEnt As SldWorks.Entity
614 –        Dim swSketchSegment As SldWorks.SketchSegment
615 –        Dim vSketchSegments As Object
616 –        Dim swSketch As SldWorks.Sketch
617 –        Dim faceinterne(1) As SldWorks.Face2
618 –        Dim swPlan As SldWorks.RefPlane = Nothing
619 –        Dim b As Integer
620 –        Dim swSommet As SldWorks.Vertex
621 –        Dim i As Integer
622 –
623 –        swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
624 –
625 –        ' faut découper toutes les faces de la liste si elles ne sont pas des faces internes
626 –        Dim MeFace As SldWorks.Face2
627 –        Dim ListeFace() As SldWorks.Face2
628 –        ReDim ListeFace(Me.lst_Faces.Count - 1)
629 –
630 –        For i = 1 To Me.lst_Faces.Count
631 –            ListeFace(i - 1) = Me.lst_Faces.Item(i)
632 –        Next
633 –
634 –        For Each MeFace In ListeFace
635 –
636 –            If Me.estPlan Then
637 –                swEnt = MeFace
638 –                swEnt.Select(False)
639 –                swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
640 –                swEnt.Select(False)
641 –                swModel.InsertSketch2(True)
642 –
643 –                swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
644 –
645 –            ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
646 –                If b = 0 Then
647 –                    Dim vEdge As Object
648 –
649 –
650 –                    vEdge = MeFace.GetEdges
651 –                    swModel.ClearSelection2(True)
652 –                    While swPlan Is Nothing
653 –                        If UBound(vEdge) - 2 < i Then MsgBox("Dans CoupeLong, problème pour créer un plan avec 3 points.  (La face est un FauxPlan)", MsgBoxStyle.Critical, "Le plan ne sera pas créé") : Exit While
654 –                        swSommet = vEdge(i).GetStartVertex()
655 –                        swEnt = swSommet
656 –                        swEnt.Select4(False, Nothing)
657 –                        swSommet = vEdge(i + 1).GetStartVertex()
658 –                        swEnt = swSommet
659 –                        swEnt.Select4(True, Nothing)
660 –                        swSommet = vEdge(i + 2).GetStartVertex()
661 –                        swEnt = swSommet
662 –                        swEnt.Select4(True, Nothing)
663 –                        i += 1
664 –                        swPlan = swModel.CreatePlaneThru3Points3(False)
665 –
666 –                    End While
667 –                End If
668 –                swEnt = swPlan
669 –                swEnt.Select(False)
670 –                swModel.InsertSketch2(True)
671 –
672 –            Else
673 –                MsgBox("Dans coupeLong, on a un type de face qui n'est pas encore traité")
674 –
675 –            End If
676 –
677 –
678 –            swSketch = swModel.GetActiveSketch2
679 –
680 –            swEnt = poutre.swArete
681 –            swEnt.Select(False)
682 –
683 –            ' créer la ligne de  «conversion de entités»
684 –            swModel.SketchUseEdge2(False)
404  
686 –            vSketchSegments = swSketch.GetSketchSegments()
687 –            swSketchSegment = vSketchSegments(0)
688 –            swSketchSegment.Select2(False, 1)  'on sélectionne l'arète de poutre...
405  
406 <            Dim x As Double, y As Double, z As Double
407 <            Commun.GetMidPointSegment(swSketchSegment, x, y, z)
406 >        'Dim swEnt As SldWorks.Entity
407 >        'Dim swSketchSegment As SldWorks.SketchSegment
408 >        'Dim vSketchSegments As Object
409 >        'Dim swSketch As SldWorks.Sketch
410 >        'Dim faceinterne(1) As SldWorks.Face2
411 >        'Dim swPlan As SldWorks.RefPlane = Nothing
412 >        'Dim b As Integer
413 >        'Dim swSommet As SldWorks.Vertex
414 >        'Dim i As Integer
415 >
416 >        'swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
417 >
418 >        '' faut découper toutes les faces de la liste si elles ne sont pas des faces internes
419 >        'Dim MeFace As SldWorks.Face2
420 >        ''Dim ListeFace() As SldWorks.Face2
421 >        ''ReDim ListeFace(Me.lst_Faces.Count - 1)
422 >
423 >        ''For i = 1 To Me.lst_Faces.Count
424 >        ''ListeFace(i - 1) = Me.lst_Faces.Item(i)
425 >        ''Next
426 >
427 >        'For Each MeFace In Me.lst_Faces 'ListeFace
428 >
429 >        '    If Me.estPlan Then
430 >        '        swEnt = MeFace
431 >        '        swEnt.Select(False)
432 >        '        swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
433 >        '        swEnt.Select(False)
434 >        '        swModel.InsertSketch2(True)
435 >
436 >        '        swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
437 >
438 >        '    ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
439 >        '        If b = 0 Then
440 >        '            Dim vEdge As Object
441 >
442 >
443 >        '            vEdge = MeFace.GetEdges
444 >        '            swModel.ClearSelection2(True)
445 >        '            While swPlan Is Nothing
446 >        '                If UBound(vEdge) - 2 < i Then MsgBox("Dans CoupeLong, problème pour créer un plan avec 3 points.  (La face est un FauxPlan)", MsgBoxStyle.Critical, "Le plan ne sera pas créé") : Exit While
447 >        '                swSommet = vEdge(i).GetStartVertex()
448 >        '                swEnt = swSommet
449 >        '                swEnt.Select4(False, Nothing)
450 >        '                swSommet = vEdge(i + 1).GetStartVertex()
451 >        '                swEnt = swSommet
452 >        '                swEnt.Select4(True, Nothing)
453 >        '                swSommet = vEdge(i + 2).GetStartVertex()
454 >        '                swEnt = swSommet
455 >        '                swEnt.Select4(True, Nothing)
456 >        '                i += 1
457 >        '                swPlan = swModel.CreatePlaneThru3Points3(False)
458 >
459 >        '            End While
460 >        '        End If
461 >        '        swEnt = swPlan
462 >        '        swEnt.Select(False)
463 >        '        swModel.InsertSketch2(True)
464 >
465 >        '    Else
466 >        '        MsgBox("Dans coupeLong, on a un type de face qui n'est pas encore traité")
467 >
468 >        '    End If
469 >
470 >
471 >        '    swSketch = swModel.GetActiveSketch2
472 >
473 >        '    swEnt = poutre.swArete
474 >        '    swEnt.Select(False)
475 >
476 >        '    ' créer la ligne de  «conversion de entités»
477 >        '    swModel.SketchUseEdge2(False)
478 >
479 >        '    vSketchSegments = swSketch.GetSketchSegments()
480 >        '    swSketchSegment = vSketchSegments(0)
481 >        '    swSketchSegment.Select2(False, 1)  'on sélectionne l'arète de poutre...
482 >
483 >        '    Dim x As Double, y As Double, z As Double
484 >        '    Commun.GetMidPointSegment(swSketchSegment, x, y, z)
485 >
486 >
487 >        '    ' sketchoffset doit avoir un mark de 1 pour l'objet à offsetter.  Une valeur négative inverse la direction
488 >        '    swModel.SketchManager.SketchOffset(poutre.GetD2, False, 0, 0, 0, 0)
489 >        '    ' pour rendre le modèle plus beau, on peut enlever la contrainte de offset et laisser solidworks mettre des contraintes automatiques...
490 >
491 >        '    Dim retval As Object
492 >        '    Dim skPointA1 As sldworks.SketchPoint = Nothing, skPointA2 As sldworks.SketchPoint = Nothing, skPointB1 As sldworks.SketchPoint = Nothing, skPointB2 As sldworks.SketchPoint = Nothing
493 >
494 >        '    vSketchSegments = swSketch.GetSketchSegments()
495 >        '    swSketchSegment = vSketchSegments(1)
496 >
497 >
498 >        '    Select Case swSketchSegment.GetType()
499 >        '        Case 0 ' on a une ligne
500 >        '            Dim sketchline As sldworks.SketchLine
501 >        '            sketchline = swSketchSegment
502 >        '            skPointA1 = sketchline.GetStartPoint2
503 >        '            skPointA2 = sketchline.GetEndPoint2()
504 >        '        Case 1 ' arc
505 >        '            Dim arc As sldworks.SketchArc
506 >        '            arc = swSketchSegment
507 >        '            skPointA1 = arc.GetStartPoint
508 >        '            skPointA2 = arc.GetEndPoint2
509 >        '        Case 2 ' ellipse
510 >        '            Dim sketchEllipse As sldworks.SketchEllipse
511 >        '            sketchEllipse = swSketchSegment
512 >        '            skPointA1 = sketchEllipse.GetStartPoint2
513 >        '            skPointA2 = sketchEllipse.GetEndPoint2
514 >        '        Case 3 ' spline
515 >        '            Dim spline As sldworks.SketchSpline
516 >        '            Dim pts() As sldworks.SketchPoint
517 >        '            spline = swSketchSegment
518 >        '            retval = spline.GetPoints2()
519 >        '            pts = retval
520 >        '            skPointA1 = pts(0)
521 >        '            skPointA2 = pts(UBound(pts))
522 >        '        Case 5 ' parabole (le 4 est du texte)
523 >        '            Dim para As sldworks.SketchParabola
524 >        '            para = swSketchSegment
525 >        '            skPointA1 = para.GetStartPoint2
526 >        '            skPointA2 = para.GetEndPoint2
527 >        '    End Select
528 >
529 >        '    swSketchSegment = vSketchSegments(0)
530 >        '    Select Case swSketchSegment.GetType()
531 >        '        Case 0 ' on a une ligne
532 >        '            Dim sketchline As sldworks.SketchLine
533 >        '            sketchline = swSketchSegment
534 >        '            skPointB1 = sketchline.GetStartPoint2
535 >        '            skPointB2 = sketchline.GetEndPoint2()
536 >        '        Case 1 ' arc
537 >        '            Dim arc As sldworks.SketchArc
538 >        '            arc = swSketchSegment
539 >        '            skPointB1 = arc.GetStartPoint
540 >        '            skPointB2 = arc.GetEndPoint2
541 >        '        Case 2 ' ellipse
542 >        '            Dim sketchEllipse As sldworks.SketchEllipse
543 >        '            sketchEllipse = swSketchSegment
544 >        '            skPointB1 = sketchEllipse.GetStartPoint2
545 >        '            skPointB2 = sketchEllipse.GetEndPoint2
546 >        '        Case 3 ' spline
547 >        '            Dim spline As sldworks.SketchSpline
548 >        '            Dim pts() As sldworks.SketchPoint
549 >        '            spline = swSketchSegment
550 >        '            retval = spline.GetPoints2()
551 >        '            pts = retval
552 >        '            skPointB1 = pts(0)
553 >        '            skPointB2 = pts(UBound(pts))
554 >        '        Case 5 ' parabole (le 4 est du texte)
555 >        '            Dim para As sldworks.SketchParabola
556 >        '            para = swSketchSegment
557 >        '            skPointB1 = para.GetStartPoint2
558 >        '            skPointB2 = para.GetEndPoint2
559 >        '    End Select
560 >
561 >        '    ' création des 2 lignes pour fermer le sketch.
562 >        '    swModel.CreateLine2(skPointA1.X, skPointA1.Y, 0, skPointB1.X, skPointB1.Y, 0)
563 >        '    swModel.CreateLine2(skPointA2.X, skPointA2.Y, 0, skPointB2.X, skPointB2.Y, 0)
564 >
565 >
566 >        '    Dim x2 As Double, y2 As Double, z2 As Double ' le midpoint de la poutre
567 >        '    Dim x3 As Double, y3 As Double, z3 As Double ' le midpoint de la poutre
568 >
569 >        '    swSketchSegment = vSketchSegments(0) ' le midpoint d'une poutre
570 >        '    Commun.GetMidPointSegment(swSketchSegment, x2, y2, z2)
571 >
572 >        '    swSketchSegment = vSketchSegments(1) ' le midpoint de l'autre poutre
573 >        '    Commun.GetMidPointSegment(swSketchSegment, x3, y3, z3)
574 >
575 >        '    Dim sk(1) As Double, r(2) As Double
576 >        '    sk(0) = (x3 + x2) / 2
577 >        '    sk(1) = (y3 + y2) / 2
578 >        '    r = Commun.TransfertSketchToModel(swSketch, sk)
579 >
580 >        '    swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
581 >        '    swModel.ClearSelection2(True)
582 >        '    swEnt = MeFace : swEnt.Select2(False, 1)
583 >        '    swEnt = swSketch : swEnt.Select2(True, 4)
584 >
585 >        '    swModel.InsertSplitLineProject(False, False)
586 >
587 >        '    Me.Flag = 20 ' pour dire que l'on a un coupeLong
588 >        '    faceinterne(b) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), swPlan) ' et ça s'occupe de créer la coque... mais je suis pas certain que c'est nécessaire
589 >        '    Me.Flag = 0
590  
591  
694 –            ' sketchoffset doit avoir un mark de 1 pour l'objet à offsetter.  Une valeur négative inverse la direction
695 –            swModel.SketchManager.SketchOffset(poutre.GetD2, False, 0, 0, 0, 0)
696 –            ' pour rendre le modèle plus beau, on peut enlever la contrainte de offset et laisser solidworks mettre des contraintes automatiques...
697 –
698 –            Dim retval As Object
699 –            Dim skPointA1 As SldWorks.SketchPoint = Nothing, skPointA2 As SldWorks.SketchPoint = Nothing, skPointB1 As SldWorks.SketchPoint = Nothing, skPointB2 As SldWorks.SketchPoint = Nothing
700 –
701 –            vSketchSegments = swSketch.GetSketchSegments()
702 –            swSketchSegment = vSketchSegments(1)
703 –
704 –
705 –            Select Case swSketchSegment.GetType()
706 –                Case 0 ' on a une ligne
707 –                    Dim sketchline As SldWorks.SketchLine
708 –                    sketchline = swSketchSegment
709 –                    skPointA1 = sketchline.GetStartPoint2
710 –                    skPointA2 = sketchline.GetEndPoint2()
711 –                Case 1 ' arc
712 –                    Dim arc As SldWorks.SketchArc
713 –                    arc = swSketchSegment
714 –                    skPointA1 = arc.GetStartPoint
715 –                    skPointA2 = arc.GetEndPoint2
716 –                Case 2 ' ellipse
717 –                    Dim sketchEllipse As SldWorks.SketchEllipse
718 –                    sketchEllipse = swSketchSegment
719 –                    skPointA1 = sketchEllipse.GetStartPoint2
720 –                    skPointA2 = sketchEllipse.GetEndPoint2
721 –                Case 3 ' spline
722 –                    Dim spline As SldWorks.SketchSpline
723 –                    Dim pts() As SldWorks.SketchPoint
724 –                    spline = swSketchSegment
725 –                    retval = spline.GetPoints2()
726 –                    pts = retval
727 –                    skPointA1 = pts(0)
728 –                    skPointA2 = pts(UBound(pts))
729 –                Case 5 ' parabole (le 4 est du texte)
730 –                    Dim para As SldWorks.SketchParabola
731 –                    para = swSketchSegment
732 –                    skPointA1 = para.GetStartPoint2
733 –                    skPointA2 = para.GetEndPoint2
734 –            End Select
735 –
736 –            swSketchSegment = vSketchSegments(0)
737 –            Select Case swSketchSegment.GetType()
738 –                Case 0 ' on a une ligne
739 –                    Dim sketchline As SldWorks.SketchLine
740 –                    sketchline = swSketchSegment
741 –                    skPointB1 = sketchline.GetStartPoint2
742 –                    skPointB2 = sketchline.GetEndPoint2()
743 –                Case 1 ' arc
744 –                    Dim arc As SldWorks.SketchArc
745 –                    arc = swSketchSegment
746 –                    skPointB1 = arc.GetStartPoint
747 –                    skPointB2 = arc.GetEndPoint2
748 –                Case 2 ' ellipse
749 –                    Dim sketchEllipse As SldWorks.SketchEllipse
750 –                    sketchEllipse = swSketchSegment
751 –                    skPointB1 = sketchEllipse.GetStartPoint2
752 –                    skPointB2 = sketchEllipse.GetEndPoint2
753 –                Case 3 ' spline
754 –                    Dim spline As SldWorks.SketchSpline
755 –                    Dim pts() As SldWorks.SketchPoint
756 –                    spline = swSketchSegment
757 –                    retval = spline.GetPoints2()
758 –                    pts = retval
759 –                    skPointB1 = pts(0)
760 –                    skPointB2 = pts(UBound(pts))
761 –                Case 5 ' parabole (le 4 est du texte)
762 –                    Dim para As SldWorks.SketchParabola
763 –                    para = swSketchSegment
764 –                    skPointB1 = para.GetStartPoint2
765 –                    skPointB2 = para.GetEndPoint2
766 –            End Select
767 –
768 –            ' création des 2 lignes pour fermer le sketch.
769 –            swModel.CreateLine2(skPointA1.X, skPointA1.Y, 0, skPointB1.X, skPointB1.Y, 0)
770 –            swModel.CreateLine2(skPointA2.X, skPointA2.Y, 0, skPointB2.X, skPointB2.Y, 0)
771 –
772 –
773 –            Dim x2 As Double, y2 As Double, z2 As Double ' le midpoint de la poutre
774 –            Dim x3 As Double, y3 As Double, z3 As Double ' le midpoint de la poutre
775 –
776 –            swSketchSegment = vSketchSegments(0) ' le midpoint d'une poutre
777 –            Commun.GetMidPointSegment(swSketchSegment, x2, y2, z2)
778 –
779 –            swSketchSegment = vSketchSegments(1) ' le midpoint de l'autre poutre
780 –            Commun.GetMidPointSegment(swSketchSegment, x3, y3, z3)
781 –
782 –            Dim sk(1) As Double, r(2) As Double
783 –            sk(0) = (x3 + x2) / 2
784 –            sk(1) = (y3 + y2) / 2
785 –            r = Commun.TransfertSketchToModel(swSketch, sk)
786 –
787 –            swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
788 –            swModel.ClearSelection2(True)
789 –            swEnt = MeFace : swEnt.Select2(False, 1)
790 –            swEnt = swSketch : swEnt.Select2(True, 4)
791 –
792 –            swModel.InsertSplitLineProject(False, False)
793 –
794 –            Me.Flag = 20 ' pour dire que l'on a un coupeLong
795 –            faceinterne(b) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), swPlan) ' et ça s'occupe de créer la coque... mais je suis pas certain que c'est nécessaire
796 –            Me.Flag = 0
797 –
798 –            'If faceinterne(b) Is Nothing Then
799 –            'swEnt = swSketch
800 –            'swEnt.Select(False)
801 –            'swModel.EditDelete()
802 –            'End If
803 –
804 –
805 –
806 –            ' reste à updater, on doit ajouter de 2 à 4 mini-poutres
807 –            'Dim vEdges As Object
808 –            'Dim Arete As SldWorks.Edge
809 –            'Dim vFaces As Object
810 –            'Dim aretePoutre As SldWorks.Edge
811 –
812 –
813 –            ''For b = 0 To 1
814 –            ''If Not faceinterne(b) Is Nothing Then
815 –            'b = 0
816 –            'While faceinterne(b) Is Nothing
817 –            '    b += 1
818 –            'End While
819 –
820 –            'vEdges = faceinterne(b).GetEdges
821 –            'For Each Arete In vEdges
822 –            '    If Distance(Arete.GetStartVertex, inter.x, inter.y, inter.z) < Epsilon Then swSommet = Arete.GetStartVertex : Exit For
823 –            '    If Distance(Arete.GetEndVertex, inter.x, inter.y, inter.z) < Epsilon Then swSommet = Arete.GetEndVertex : Exit For
824 –            'Next
825 –
826 –            'Dim T As Double
827 –            'Dim xyz(2) As Double
828 –            'Dim g As Integer
829 –            'Dim courbe As SldWorks.Curve
830 –
831 –            'T = poutre.GetT(inter.x, inter.y, inter.z)
832 –
833 –            'vEdges = swSommet.GetEdges
834 –
835 –            'T -= 10000 * Epsilon
836 –
837 –            'For g = 0 To UBound(vEdges) ' boucle pas optimisée en vitesse
838 –            '    Arete = vEdges(g)
839 –            '    If poutre.Evaluer(T, xyz) Then
840 –            '        courbe = Arete.GetCurve
841 –            '        If Distance(courbe, xyz(0), xyz(1), xyz(2)) < Epsilon Then aretePoutre = Arete
842 –            '    ElseIf poutre.Evaluer(T + 20000 * Epsilon, xyz) Then
843 –            '        courbe = Arete.GetCurve
844 –            '        If Distance(courbe, xyz(0), xyz(1), xyz(2)) < Epsilon Then aretePoutre = Arete ' la distance devrait être entre la droite (et non l'arête) et le point.
845 –            '    End If
846 –            'Next g
847 –
848 –
849 –            'If aretePoutre Is Nothing Then
850 –            '    ' putain d'enfoiré de merde!!!! on trouve pas la courbe de la poutre. alors on sort avec dignité!
851 –            '    Exit Sub
852 –            '    ' anyway on avait dit en réunion de ne pas mettre de minipoutres...
853 –            'End If
854 –
855 –
856 –            '' on a l'arète de la poutre, avec la boucle de la face on prend une arète avant et une arête après.
857 –            'Dim swBoucle As SldWorks.Loop2
858 –            'Dim AreteAvant As SldWorks.Edge, AreteSuivant As SldWorks.Edge, areteTest As SldWorks.Edge
859 –            'Dim varete As Object
860 –            'Dim Mini1 As SldWorks.Edge, Mini2 As SldWorks.Edge, Mini3 As SldWorks.Edge, Mini4 As SldWorks.Edge
861 –
862 –            'Dim j As Integer
863 –
864 –            'If Not faceinterne(0) Is Nothing Then
865 –            '    swBoucle = faceinterne(0).GetFirstLoop ' devrait y en avoir juste une...
866 –            '    varete = swBoucle.GetEdges()
867 –
868 –            '    For j = 0 To UBound(varete)
869 –            '        areteTest = varete(j)
870 –            '        If areteTest Is aretePoutre Then
871 –            '            If j <> 0 Then Mini1 = varete(j - 1) Else Mini1 = varete(UBound(varete))
872 –            '            If j <> UBound(varete) Then Mini2 = varete(j + 1) Else Mini2 = varete(0)
873 –            '        End If
874 –            '    Next j
875 –            'End If
876 –
877 –            'If Not faceinterne(1) Is Nothing Then
878 –            '    swBoucle = faceinterne(1).GetFirstLoop ' devrait y en avoir juste une...
879 –            '    varete = swBoucle.GetEdges()
880 –
881 –            '    For j = 0 To UBound(varete)
882 –            '        areteTest = varete(j)
883 –            '        If areteTest Is aretePoutre Then
884 –            '            If j <> 0 Then Mini3 = varete(j - 1) Else Mini3 = varete(UBound(varete))
885 –            '            If j <> UBound(varete) Then Mini4 = varete(j + 1) Else Mini4 = varete(0)
886 –            '        End If
887 –            '    Next j
888 –            'End If
889 –            'If Not Mini1 Is Nothing Then
890 –            '    swEnt = Mini1
891 –            '    If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
892 –            'End If
893 –
894 –            'If Not Mini2 Is Nothing Then
895 –            '    swEnt = Mini2
896 –            '    If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
897 –            'End If
898 –
899 –            'If Not Mini3 Is Nothing Then
900 –            '    swEnt = Mini3
901 –            '    If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
902 –            'End If
903 –
904 –            'If Not Mini4 Is Nothing Then
905 –            '    swEnt = Mini4
906 –            '    If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
907 –            'End If
908 –        Next MeFace
909 –
910 –
911 –        swModel.SetInferenceMode(True) ' ne pas mettre de contraintes par défaut
912 –        'swModel.SetAddToDB(False)
913 –        'swModel.SetDisplayWhenAdded(True) ' accélérer les performances
914 –
592      End Sub
593  
594  
918 –    ' sub qui coupe la face normalement, avec un X.... [cas #1]
919 –    Friend Sub CoupeX(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre)
920 –
921 –        Dim swEnt As SldWorks.Entity = Nothing
922 –        Dim Directionnel As Boolean, Flip As Boolean
923 –        Dim Faces(3) As SldWorks.Face2
924 –        Dim r(2) As Double
925 –        Dim LaSurface As SldWorks.Surface
926 –        Dim sens As Boolean
927 –        Dim p(2) As Double
928 –        Dim retour() As Double
929 –
930 –        swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
931 –        'swModel.SetAddToDB(True)
932 –        'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
933 –
934 –
935 –        ' l'idée est de sélectionner le point et l'arète puis d'utiliser CreatePlanePerCurveAndPassPoint3
936 –        Dim planReference As SldWorks.RefPlane
937 –        Dim swsketch As SldWorks.Sketch
938 –        Dim swSommet As SldWorks.Vertex, swSommet2 As SldWorks.Vertex
939 –        Dim pointdeb(2) As Double, pointfin(2) As Double
940 –
941 –        'swModel.Extension.SelectByID2("", "POINTREF", inter.x, inter.y, inter.z, False, 0, Nothing, 0)
942 –        ' faut vraiment sélectionner le bon point...
943 –        swSommet = poutre.swArete.GetStartVertex()
944 –        swSommet2 = poutre.swArete.GetEndVertex()
945 –        If swSommet Is Nothing Then
946 –            MsgBox("On a un cercle ou courbe sans sommets, dans coupeX, pas encore traité.  Ne peut pas mettre un plan si pas de sommet")
947 –        Else
948 –            If Distance(swSommet, inter.x, inter.y, inter.z) < Epsilon Then
949 –                swEnt = swSommet
950 –            ElseIf Distance(swSommet2, inter.x, inter.y, inter.z) < Epsilon Then
951 –                swEnt = swSommet2
952 –            Else
953 –                MsgBox("Dans coupeX, l'intersection n'est pas sur un sommet.  Pas encore traité.  Nécessite de créer un point au coordonnées d'intersection")
954 –            End If
955 –        End If
956 –
957 –        swEnt.Select4(False, Nothing)
958 –        swEnt = poutre.swArete
959 –        swEnt.Select(True)
960 –
961 –        If Me.estPlan Or Me.estFauxPlan(inter.x, inter.y, inter.z) Then
962 –            ' si la coque est plane alors on projette le plan de référence des deux cotés, sinon on doit le décaler vers le bas
963 –            planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
964 –            Directionnel = False
965 –            Flip = False
966 –        ElseIf Me.estCylindre Then
967 –            ' on a un cylindre, on ne projette pas des 2 cotés.  On créé un plan, puis un autre plus bas pour ensuite projeter d'un seul coté.
968 –            Dim PlanDessus As SldWorks.RefPlane
969 –            Dim Rayon As Double, L As Double, B As Double, phi As Double, dist As Double, temp1 As Double, temp2 As Double
970 –            Dim u(2) As Double, v(2) As Double
971 –            PlanDessus = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
972 –            temp1 = poutre.GetD1
973 –            temp2 = poutre.GetD2
974 –            L = Math.Sqrt(temp1 * temp1 + temp2 * temp2)
975 –            Rayon = Me.GetRayonCylindre()
976 –            u = poutre.GetOrientation(inter.x, inter.y, inter.z)
977 –            v = Me.GetNormale(inter.x, inter.y, inter.z)
978 –            phi = -(Math.Acos(Outils_Math.cosdir(u, v)))
979 –            B = Math.Abs(L / 2 * Math.Sin(phi))
980 –            dist = Rayon - Math.Sqrt(Rayon * Rayon - ((L / 2) * (L / 2))) + B
981 –            If dist < 0 Then MsgBox("Gros problème pour couper le cylindre, la poutre est plus grosse!!!!!!", MsgBoxStyle.Critical) : Exit Sub
982 –
983 –            swEnt = PlanDessus
984 –            swEnt.Select(False)
985 –            Directionnel = True
986 –
987 –            Flip = Flipper(PlanDessus, inter)
988 –
989 –            planReference = swModel.CreatePlaneAtOffset3(dist * 2, Flip, True)
990 –        Else
991 –            MsgBox("La coque n'est ni un cylindre, ni un plan" & vbCr & "Le résultat n'est pas certain...", MsgBoxStyle.Information, "Avertissement")
992 –            planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
993 –            Directionnel = False
994 –            Flip = False
995 –        End If
996 –
997 –
998 –
999 –        LaSurface = Me.SwFace.GetSurface()
1000 –        sens = Me.SwFace.FaceInSurfaceSense()
1001 –
1002 –        ' skx est la coordonnée du point de ref en coord de sketch, Rx est le point de référence dans le repère global.
1003 –        Dim i As Integer, MettreFI As Boolean
1004 –        Dim swFeat As SldWorks.Feature
1005 –
1006 –        For i = 0 To 1
1007 –
1008 –            swEnt = planReference
1009 –            swEnt.Select(False)
1010 –            swModel.InsertSketch2(False)
1011 –            swModel.ClearSelection2(True)
1012 –            swFeat = swModel.FeatureByPositionReverse(0)
1013 –            swModel.SelectByID(swFeat.Name, "SKETCH", 0, 0, 0)
1014 –            swModel.EditSketch()
1015 –            swsketch = swModel.GetActiveSketch2
1016 –
1017 –            p(0) = inter.x : p(1) = inter.y : p(2) = inter.z
1018 –            retour = Commun.TransfertModelSketch(swsketch, p)
1019 –
1020 –
1021 –            r = DessineSectionPoutre(poutre, retour(0), retour(1), i + 1, swsketch, inter, MettreFI)
1022 –            swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
1023 –            swModel.ClearSelection2(True)
1024 –
1025 –            Dim face As SldWorks.Face2
1026 –            For Each face In Me.lst_Faces
1027 –                swModel.ClearSelection2(True)
1028 –                swEnt = face : swEnt.Select2(False, 1)
1029 –                swEnt = swsketch : swEnt.Select2(True, 4)
1030 –                swModel.InsertSplitLineProject(Directionnel, Flip)
1031 –            Next
1032 –
1033 –
1034 –            Me.SwFace.DetachSurface()
1035 –            Me.SwFace.AttachSurface(LaSurface, sens)
1036 –
1037 –            Faces(i) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference, MettreFI)
1038 –            Commun.MettreUnPoint(r(0), r(1), r(2))
1039 –
1040 –            If Faces(i) Is Nothing Then
1041 –                swEnt.Select(False)
1042 –                swModel.EditDelete()
1043 –            End If
1044 –            If Flag = 2 Then Flag = 0 : Exit For
1045 –
1046 –        Next i
1047 –
1048 –        swModel.SetInferenceMode(True)
1049 –        'swModel.SetAddToDB(False)
1050 –        'swModel.SetDisplayWhenAdded(True)
595  
596 +    ''' <summary>
597 +    ''' Sub qui appelle le découpage de la face
598 +    ''' </summary>
599 +    ''' <remarks>On devrait revoir cette sub en fonction des nouveaux outils de VB2005</remarks>
600 +    Public Overridable Sub decouper()
601 +        MsgBox("La fonction non Overridé a été appelée!")
602      End Sub
603  
604  
605 <    ' Sub qui appelle le découpage de la face
606 <    Public Sub decouper()
607 <
608 <        If lst_InterPoutre.Count = 0 Then Exit Sub ' sortir si on a pas d'intersection
609 <
610 <
611 <        ' les attributs ne sont pas updatés sur les faces (mais sur les arètes et les sommets c'est OK)
612 <        ' on mémorise l'attribut de la face et on la réapplique à la fin.
613 <
614 <
615 <        Dim i As Integer
616 <        Dim inter As InterPoutreVolume
617 <        Dim nb1 As Integer, nb2 As Integer, nb3 As Integer, nb5 As Integer
618 <        Dim poutre1 As SlyAretePoutre = Nothing, poutre3 As SlyAretePoutre = Nothing
619 <        Dim lst_poutre2 As New Collection
620 <        Dim aire As Double
621 <        Dim poutreTest As SlyAretePoutre
622 <
1073 <        Dim lst_coupeXinter As New Collection
1074 <        Dim lst_coupeXPoutre As New Collection
1075 <        Dim lst_coupeLinter As New Collection
1076 <        Dim lst_coupeLPoutre As New Collection
1077 <        Dim lst_coupeCinter As New Collection
1078 <        Dim lst_coupeCPoutre As New Collection
1079 <
1080 <
1081 <        For Each inter In lst_InterPoutre
1082 <
1083 <            'pour chaque intersection on peut avoir plusieurs poutres...
1084 <            For i = 1 To inter.lst_sPoutre.Count
1085 <                poutreTest = inter.lst_sPoutre.Item(i)
1086 <                Select Case CInt(inter.lst_type.Item(i))
1087 <                    Case 1
1088 <                        If poutreTest.GetAireCarree > aire Then poutre1 = poutreTest
1089 <                        nb1 += 1
1090 <                    Case 2
1091 <                        lst_poutre2.Add(poutreTest)
1092 <                        nb2 += 1
1093 <                    Case 3
1094 <                        If poutreTest.GetAireCarree > aire Then poutre3 = poutreTest
1095 <                        nb3 += 1
1096 <                    Case 5 ' un poutre à faceDeSection
1097 <                        nb5 += 1
1098 <                    Case 22
1099 <                        ' on fait rien, mais c'est pour éviter le msgbox du case else...
1100 <                    Case Else
1101 <                        MsgBox("Problème dans découper de SlyFaceCoque, le type d'intersection n'est pas reconnu", MsgBoxStyle.Critical)
1102 <                End Select
1103 <            Next i
1104 <
1105 <
1106 <
1107 <            If nb1 > 0 Then 'CoupeX(inter, poutre1) ' on coupe le x en premier
1108 <                lst_coupeXinter.Add(inter)
1109 <                lst_coupeXPoutre.Add(poutre1)
1110 <            End If
1111 <
1112 <
1113 <            For Each poutreTest In lst_poutre2 ' puis on coupe sur la longueur 'CoupeLong(inter, poutreTest)
1114 <                lst_coupeLinter.Add(inter)
1115 <                lst_coupeLPoutre.Add(poutreTest)
605 >    ''' <summary>
606 >    ''' Renvoie le nombre d'arêtes dans la face principale
607 >    ''' </summary>
608 >    ''' <value></value>
609 >    ''' <returns></returns>
610 >    ''' <remarks></remarks>
611 >    Public ReadOnly Property NbSommets() As Integer
612 >        Get
613 >            Dim lst_sommets As New Collections.Generic.List(Of sldworks.Vertex)
614 >            Dim swSommet As sldworks.Vertex = Nothing
615 >            Dim vedges As Object = Me.SwFace.GetEdges
616 >            For Each edge As sldworks.Edge In vedges
617 >                swSommet = edge.GetStartVertex
618 >                If swSommet IsNot Nothing Then
619 >                    lst_sommets.Add(swSommet)
620 >                    swSommet = edge.GetEndVertex
621 >                    lst_sommets.Add(swSommet)
622 >                End If
623              Next
624 +            Return lst_sommets.Count
625 +        End Get
626 +    End Property
627  
628 <            If nb3 > 0 Then 'CoupeCote(inter, poutre3) ' finalement on coupe sur les cotés
629 <                lst_coupeCinter.Add(inter)
630 <                lst_coupeCPoutre.Add(poutre3)
631 <            End If
632 <
633 <            If nb5 = 1 And (nb1 > 0 Or nb2 > 0 Or nb3 > 0) Then
634 <                MsgBox("Problème, on a un type d'intersection impossible dans la vraie vie!", MsgBoxStyle.Exclamation, "Design impossible à obtenir en réalité...")
1125 <            End If
1126 <
1127 <
1128 <            lst_poutre2.Clear()
1129 <            nb1 = 0 : nb2 = 0 : nb3 = 0
1130 <
1131 <
1132 <        Next inter
1133 <
1134 <
1135 <        ' maintenant on a toutes les lists d'intersections.  On les coupe.
1136 <        For i = 1 To lst_coupeXinter.Count
1137 <            CoupeX(lst_coupeXinter.Item(i), lst_coupeXPoutre.Item(i))
1138 <        Next
1139 <
1140 <        For i = 1 To lst_coupeLinter.Count
1141 <            CoupeLong(lst_coupeLinter.Item(i), lst_coupeLPoutre.Item(i))
1142 <        Next
1143 <
1144 <        For i = 1 To lst_coupeCinter.Count
1145 <            CoupeCote(lst_coupeCinter.Item(i), lst_coupeCPoutre.Item(i))
1146 <        Next
1147 <        If nb5 = 1 Then
1148 <            If lst_InterPoutre.Count <> 1 Then MsgBox("Plus d'une intersection du type FacedeSection....")
1149 <            CoupeFaceDeSection(lst_InterPoutre(1))
1150 <        End If
1151 <
1152 <    End Sub
1153 <
1154 <    Private Sub CoupeFaceDeSection(ByRef inter As InterPoutreVolume)
1155 <        Dim swEnt As SldWorks.Entity = Nothing
628 >    ''' <summary>
629 >    ''' Coupe si nécesaire la face lorsque l'on a une poutre avec face de section.  À noter que si l'on coupe c'est avec un angle de pi / 8
630 >    ''' </summary>
631 >    ''' <param name="inter"></param>
632 >    ''' <remarks></remarks>
633 >    Protected Sub CoupeFaceDeSection(ByRef inter As InterPoutreVolume)
634 >        Dim swEnt As sldworks.Entity = Nothing
635          Dim Directionnel As Boolean
636 <        Dim Faces(3) As SldWorks.Face2
636 >        Dim Faces(3) As sldworks.Face2
637          Dim r(2) As Double
638          Dim p(2) As Double
639 <        Dim planReference As SldWorks.RefPlane = Nothing
640 <        Dim swsketch As SldWorks.Sketch
639 >        Dim planReference As sldworks.RefPlane = Nothing
640 >        Dim swsketch As sldworks.Sketch
641          Dim pointdeb(2) As Double, pointfin(2) As Double
642 <        Dim sketchline As SldWorks.SketchLine
643 <        Dim swFeat As SldWorks.Feature
642 >        Dim sketchline As sldworks.SketchLine
643 >        Dim swFeat As sldworks.Feature
644  
645  
646          swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
# Line 1171 | Line 650 | Public Class SuperFace
650          swModel.InsertSketch2(False)
651          swsketch = swModel.GetActiveSketch2
652  
653 <        ' dessin de la forme à faire...
653 >        ' dessin de la forme à faire SI NÉCESSAIRE
654 >        If Me.NbSommets = 0 OrElse Distance(Me.SwFace, inter.x, inter.y, inter.z) < Epsilon Then
655  
656 <        Dim xyzc() As Double, xyz(2) As Double
657 <        xyz(0) = inter.x : xyz(1) = inter.y : xyz(2) = inter.z
658 <        xyzc = Commun.TransfertModelSketch(swsketch, xyz)
656 >            Dim xyzc() As Double, xyz(2) As Double
657 >            xyz(0) = inter.x : xyz(1) = inter.y : xyz(2) = inter.z
658 >            xyzc = Commun.TransfertModelSketch(swsketch, xyz)
659 >
660 >            sketchline = swModel.CreateLine2(xyzc(0), xyzc(1), 0, xyzc(0) + Math.Cos(Pi / 8), xyzc(1) + Math.Sin(Pi / 8), 0)
661 >            sketchline = swModel.CreateLine2(xyzc(0), xyzc(1), 0, xyzc(0) - Math.Cos(Pi / 8), xyzc(1) + Math.Sin(Pi / 8), 0)
662 >            swModel.CreateArc2(xyzc(0), xyzc(1), 0, xyzc(0) + Math.Cos(Pi / 8), xyzc(1) + Math.Sin(Pi / 8), 0, xyzc(0) - Math.Cos(Pi / 8), xyzc(1) + Math.Sin(Pi / 8), 0, 1) ' le dernier param est la direction.  1 ou -1
663  
664 <        sketchline = swModel.CreateLine2(xyzc(0), xyzc(1), 0, xyzc(0) + Math.Cos(Pi / 4), xyzc(1) + Math.Sin(Pi / 4), 0)
665 <        sketchline = swModel.CreateLine2(xyzc(0), xyzc(1), 0, xyzc(0) - Math.Cos(Pi / 4), xyzc(1) + Math.Sin(Pi / 4), 0)
1182 <        swModel.CreateArc2(xyzc(0), xyzc(1), 0, xyzc(0) + Math.Cos(Pi / 4), xyzc(1) + Math.Sin(Pi / 4), 0, xyzc(0) - Math.Cos(Pi / 4), xyzc(1) + Math.Sin(Pi / 4), 0, 1) ' le dernier param est la direction.  1 ou -1
1183 <
1184 <        swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
1185 <        swModel.ClearSelection2(True)
664 >            swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
665 >            swModel.ClearSelection2(True)
666  
667 <        swEnt = Me.SwFace : swEnt.Select2(False, 1)
668 <        swEnt = swsketch : swEnt.Select2(True, 4)
669 <        swModel.InsertSplitLineProject(Directionnel, False)
667 >            swEnt = Me.SwFace : swEnt.Select2(False, 1)
668 >            swEnt = swsketch : swEnt.Select2(True, 4)
669 >            swModel.InsertSplitLineProject(Directionnel, False)
670  
671  
672 <        ' flagger les 2 faces comme faces Internes.
673 <        Dim vface As Object
674 <        Dim face As SldWorks.Face2
675 <        Dim attr As SldWorks.Attribute
676 <        swFeat = swModel.FeatureByPositionReverse(0)
677 <        Try
678 <            vface = swFeat.GetFaces
679 <            For Each face In vface
680 <                '**************
681 <                Dim nom2 As String = "FaceInterne" & no
682 <                swEnt = face
683 <                attr = swEnt.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
684 <                If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, face, nom2, 0, 2) ' 0 = swThisconfig
685 <                While attr Is Nothing
686 <                    no += 1
687 <                    nom2 = "FaceInterne" & CStr(no)
688 <                    attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, face, nom2, 0, 2)
689 <                End While
690 <                GererDossiers("FaceInternes", nom2)
691 <                no += 1
1212 <
1213 <
1214 <                '**************
1215 <                Me.AjouterFace(face)
1216 <            Next face
1217 <        Catch
1218 <            ' si on a une poutre dessinée en partie, on aura pas de feature... mais on a la face...
1219 <            ' on doit donc le déterminer anyway
1220 <        End Try
672 >            ' flagger les 2 faces comme faces Internes.
673 >            Dim vface As Object
674 >            Dim face As sldworks.Face2 = Nothing
675 >            swFeat = swModel.FeatureByPositionReverse(0)
676 >            Try
677 >                vface = swFeat.GetFaces
678 >                For Each face In vface
679 >                    no = Me.MettreAttributFaceInterne(face, 2 * Me.Aire / Me.Perimetre, True) ' plus certain que l'on a besoin du numéro
680 >                    Me.AjouterFace(face)
681 >                Next face
682 >            Catch
683 >                ' si on a une poutre dessinée en partie, on aura pas de feature... mais on a la face...
684 >                ' on doit donc le déterminer anyway
685 >            End Try
686 >
687 >            ' si ça ne touche pas à la face
688 >            If Not Distance(Me.SwFace, inter.x, inter.y, inter.z) < Epsilon Then
689 >                AjouterMiniPoutresSurFaceInterne(inter.lst_sPoutre.Item(1), face, inter.x, inter.y, inter.z)
690 >                'MsgBox("On ajoute une mini-poutre entre la poutre " & inter.lst_sPoutre.Item(1).nom & vbCr & " et le point ( " & Format(inter.x * 1000, "0000") & " , " & Format(inter.y * 1000, "0000") & " , " & Format(inter.y * 1000, "0000") & " )")
691 >            End If
692  
693 <        ' si ça ne touche pas à la face
694 <        If Not Distance(Me.SwFace, inter.x, inter.y, inter.z) < Epsilon Then
695 <            AjouterMiniPoutresSurFaceInterne(inter.lst_sPoutre.Item(1), face, inter.x, inter.y, inter.z)
696 <            'MsgBox("On ajoute une mini-poutre entre la poutre " & inter.lst_sPoutre.Item(1).nom & vbCr & " et le point ( " & Format(inter.x * 1000, "0000") & " , " & Format(inter.y * 1000, "0000") & " , " & Format(inter.y * 1000, "0000") & " )")
693 >        Else ' flagger la seule face comme face interne
694 >            Me.MettreAttributFaceInterne(Me.SwFace, 2 * Me.Aire / Me.Perimetre, True)
695 >            If Not Distance(Me.SwFace, inter.x, inter.y, inter.z) < Epsilon Then
696 >                AjouterMiniPoutresSurFaceInterne(inter.lst_sPoutre.Item(1), Me.SwFace, inter.x, inter.y, inter.z)
697 >                'MsgBox("On ajoute une mini-poutre entre la poutre " & inter.lst_sPoutre.Item(1).nom & vbCr & " et le point ( " & Format(inter.x * 1000, "0000") & " , " & Format(inter.y * 1000, "0000") & " , " & Format(inter.y * 1000, "0000") & " )")
698 >            End If
699          End If
1227 –
700          swModel.SetInferenceMode(True)
701  
702      End Sub
703  
704  
705      Friend Overridable Sub chercherAttributs()
706 <        Dim swEnt As SldWorks.Entity
707 <        Dim attr As SldWorks.Attribute
706 >        Dim swEnt As sldworks.Entity
707 >        Dim attr As sldworks.Attribute
708  
709          swEnt = Me.SwFace
710  
# Line 1243 | Line 715 | Public Class SuperFace
715  
716      End Sub
717  
718 <    Private Function Flipper(ByRef PlanDessus As SldWorks.RefPlane, ByRef inter As InterPoutreVolume) As Boolean
718 >    Protected Function Flipper(ByRef PlanDessus As sldworks.RefPlane, ByRef inter As InterAreteFace) As Boolean
719          ' function qui dit si l'on doit flipper le sens du plan de référence.
720          ' calcul de la direction à prendre
721          Dim retval As Object
# Line 1251 | Line 723 | Public Class SuperFace
723          Dim ret2(6) As Double
724          Dim normalePlan(2) As Double
725          Dim OV(2) As Double
726 <        Dim swSurf As SldWorks.Surface
726 >        Dim swSurf As sldworks.Surface
727  
728          retval = PlanDessus.GetRefPlaneParams()
729          ret = retval
730          normalePlan(0) = ret(6) : normalePlan(1) = ret(7) : normalePlan(2) = ret(8)
731 <        swSurf = Me.lst_Faces.Item(1).GetSurface
731 >        swSurf = Me.lst_Faces.Item(0).GetSurface
732          retval = swSurf.CylinderParams() ' 7 doubles, les 3 premiers sont l'origine
733          ret2 = retval
734          OV(0) = ret2(0) - inter.x : OV(1) = ret2(1) - inter.y : OV(2) = ret2(2) - inter.z
# Line 1267 | Line 739 | Public Class SuperFace
739  
740      End Function
741  
742 <
743 <    Private Function DessineSectionPoutre(ByRef Poutre As SlyAretePoutre, ByVal TranslationX As Double, ByVal TranslationY As Double, ByVal numero As Integer, ByRef swSketch As SldWorks.Sketch, ByRef inter As InterPoutreVolume, ByRef MettreFI As Boolean) As Double()
742 >    ''' <summary>
743 >    ''' Sub qui dessine (insère des lignes) sur le sketch en fonction de la forme de la poutre.
744 >    ''' </summary>
745 >    ''' <param name="Poutre"></param>
746 >    ''' <param name="TranslationX"></param>
747 >    ''' <param name="TranslationY"></param>
748 >    ''' <param name="numero"></param>
749 >    ''' <param name="swSketch"></param>
750 >    ''' <param name="inter"></param>
751 >    ''' <param name="MettreFI"></param>
752 >    ''' <returns></returns>
753 >    ''' <remarks></remarks>
754 >    Protected Function DessineSectionPoutre(ByRef Poutre As SlyAretePoutre, ByVal TranslationX As Double, ByVal TranslationY As Double, ByVal numero As Integer, ByRef swSketch As sldworks.Sketch, ByRef inter As InterAreteFace, ByRef MettreFI As Boolean) As Double()
755          ' le sketch est déjà inséré, il faut juste mettre des swmodel.line ou autre
756          ' doit retourner r() qui est un point situé à l'intérieur de la coupe
757 <        Dim sketchline As SldWorks.SketchSegment
757 >        Dim sketchline As sldworks.SketchSegment
758          Dim longueur As Double
759          Dim r(2) As Double
760          Dim sk(1) As Double
# Line 1521 | Line 1004 | Public Class SuperFace
1004              End Select
1005              MettreFI = True
1006  
1007 <        ElseIf Left(Nomsection, 4) = "Tube" Or Nomsection = " Tuyau (Pipe) générique" Then ' le tube rond
1007 >        ElseIf Left(Nomsection, 5) = "Tuyau" OrElse Nomsection = " Tuyau (Pipe) générique" Then ' le tube rond
1008              Dim p(4, 1) As Double
1009              p(0, 0) = Poutre.GetD1 / 2 - Poutre.GetD3
1010              p(0, 1) = 0
# Line 1599 | Line 1082 | Public Class SuperFace
1082                      '    MettreFI = True
1083              End Select
1084  
1085 +        ElseIf Left(Poutre.GetNomSection, 2) = "Cy" Or Nomsection = " Cylindrique (Rod) générique" Then ' Pipe,
1086 +            Dim P(2, 1) As Double
1087 +            Dim d As Double, e As Double
1088 +            d = Poutre.GetD1 / 4 ' Math.Sin(30)  ( et on doit diviser le diamètre par 2)
1089 +            e = Poutre.GetD1 * Math.Sqrt(3) / 4 ' cos (30°)
1090 +
1091 +            P(0, 0) = 0
1092 +            P(0, 1) = 0
1093 +            P(1, 0) = d
1094 +            P(1, 1) = -e
1095 +            P(2, 0) = d
1096 +            P(2, 1) = e
1097 +
1098 +            Select Case numero
1099 +                Case 1
1100 +                    r(0) = P(0, 0) + 1000 * Epsilon
1101 +                    r(1) = 0 : r(2) = 0
1102 +                    Outils_Math.Rotation2D(pt3, r(0), r(1))
1103 +                    r(0) += TranslationX
1104 +                    r(1) += TranslationY
1105 +                    r = Commun.TransfertSketchToModel(swSketch, r)
1106 +                    pt3(0) -= TranslationX
1107 +                    pt3(1) -= TranslationY
1108 +                    pt3(0) /= longueur : pt3(1) /= longueur
1109 +                    For i = 0 To 2
1110 +                        Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1111 +                        P(i, 0) += TranslationX
1112 +                        P(i, 1) += TranslationY
1113 +                    Next i
1114 +                    ReDim Ligne(7)
1115 +                    Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
1116 +                    Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
1117 +                    swModel.CreateArc2(P(0, 0), P(0, 1), 0, P(1, 0), P(1, 1), 0, P(2, 0), P(2, 1), 0, 1) ' le dernier param est la direction.  1 ou -1
1118 +
1119 +                Case 2
1120 +                    r(0) = P(0, 0) - 1000 * Epsilon
1121 +                    r(1) = 0 : r(2) = 0
1122 +                    Outils_Math.Rotation2D(pt3, r(0), r(1))
1123 +                    r(0) += TranslationX
1124 +                    r(1) += TranslationY
1125 +                    r = Commun.TransfertSketchToModel(swSketch, r)
1126 +
1127 +                    pt3(0) -= TranslationX
1128 +                    pt3(1) -= TranslationY
1129 +                    pt3(0) /= longueur : pt3(1) /= longueur
1130 +                    For i = 0 To 2
1131 +                        Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1132 +                        P(i, 0) += TranslationX
1133 +                        P(i, 1) += TranslationY
1134 +                    Next i
1135 +                    ReDim Ligne(7)
1136 +                    Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
1137 +                    Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
1138 +
1139 +                    swModel.CreateArc2(P(0, 0), P(0, 1), 0, P(1, 0), P(1, 1), 0, P(2, 0), P(2, 1), 0, -1) ' le dernier param est la direction.  1 ou -1
1140 +
1141 +            End Select
1142 +            MettreFI = True
1143 +
1144 +
1145          ElseIf Left(Nomsection, 1) = "C" Or Nomsection = " Poutre en C générique" Then ' le channel
1146              Dim P(7, 1) As Double
1147  
# Line 1623 | Line 1166 | Public Class SuperFace
1166                      P(7, 1) = P(0, 1)
1167  
1168                      r(0) = P(0, 0) + 1000 * Epsilon
1169 <                    r(1) = 0 : r(2) = 0
1169 >                    r(1) = P(0, 1) : r(2) = 0
1170                      Outils_Math.Rotation2D(pt3, r(0), r(1))
1171                      r(0) += TranslationX
1172                      r(1) += TranslationY
# Line 1708 | Line 1251 | Public Class SuperFace
1251  
1252                      P(0, 0) = 0
1253                      P(0, 1) = 0
1254 <                    P(1, 0) = -d
1254 >                    P(1, 0) = d
1255                      P(1, 1) = -Poutre.GetD4 / 2.0R
1256                      P(2, 0) = -(Poutre.GetD1 - Poutre.GetD5 - Poutre.GetD3)
1257                      P(2, 1) = -Poutre.GetD4 / 2.0R
# Line 1725 | Line 1268 | Public Class SuperFace
1268                      P(8, 0) = P(1, 0)
1269                      P(8, 1) = -P(1, 1)
1270  
1271 <                    r(0) = P(0, 0) + 1000 * Epsilon
1271 >                    r(0) = P(0, 0) - 1000 * Epsilon
1272                      r(1) = 0 : r(2) = 0
1273                      Outils_Math.Rotation2D(pt3, r(0), r(1))
1274                      r(0) += TranslationX
# Line 1755 | Line 1298 | Public Class SuperFace
1298                      P(0, 0) = 0
1299                      P(0, 1) = 0
1300  
1301 <                    P(1, 0) = -d
1301 >                    P(1, 0) = d
1302                      P(1, 1) = -Poutre.GetD4 / 2.0R
1303                      P(2, 0) = Poutre.GetD5
1304                      P(2, 1) = -Poutre.GetD4 / 2.0R
# Line 1764 | Line 1307 | Public Class SuperFace
1307                      P(4, 0) = P(1, 0)
1308                      P(4, 1) = P(3, 1)
1309  
1310 <                    r(0) = P(0, 0) - 1000 * Epsilon
1310 >                    r(0) = P(0, 0) + 1000 * Epsilon
1311                      r(1) = 0 : r(2) = 0
1312                      Outils_Math.Rotation2D(pt3, r(0), r(1))
1313                      r(0) += TranslationX
# Line 1789 | Line 1332 | Public Class SuperFace
1332              End Select
1333              MettreFI = True
1334  
1792 –        ElseIf Left(Poutre.GetNomSection, 1) = "P" Or Nomsection = " Circulaire pleine générique" Then ' Pipe,
1793 –            Dim P(2, 1) As Double
1794 –            Dim d As Double, e As Double
1795 –            d = Poutre.GetD1 / 4 ' Math.Sin(30)  ( et on doit diviser le diamètre par 2)
1796 –            e = Poutre.GetD1 * Math.Sqrt(3) / 4 ' cos (30°)
1797 –
1798 –            P(0, 0) = 0
1799 –            P(0, 1) = 0
1800 –            P(1, 0) = d
1801 –            P(1, 1) = -e
1802 –            P(2, 0) = d
1803 –            P(2, 1) = e
1804 –
1805 –            Select Case numero
1806 –                Case 1
1807 –                    r(0) = P(0, 0) + 1000 * Epsilon
1808 –                    r(1) = 0 : r(2) = 0
1809 –                    Outils_Math.Rotation2D(pt3, r(0), r(1))
1810 –                    r(0) += TranslationX
1811 –                    r(1) += TranslationY
1812 –                    r = Commun.TransfertSketchToModel(swSketch, r)
1813 –                    pt3(0) -= TranslationX
1814 –                    pt3(1) -= TranslationY
1815 –                    pt3(0) /= longueur : pt3(1) /= longueur
1816 –                    For i = 0 To 2
1817 –                        Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1818 –                        P(i, 0) += TranslationX
1819 –                        P(i, 1) += TranslationY
1820 –                    Next i
1821 –                    ReDim Ligne(7)
1822 –                    Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
1823 –                    Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
1824 –                    swModel.CreateArc2(P(0, 0), P(0, 1), 0, P(1, 0), P(1, 1), 0, P(2, 0), P(2, 1), 0, 1) ' le dernier param est la direction.  1 ou -1
1825 –
1826 –                Case 2
1827 –                    r(0) = P(0, 0) - 1000 * Epsilon
1828 –                    r(1) = 0 : r(2) = 0
1829 –                    Outils_Math.Rotation2D(pt3, r(0), r(1))
1830 –                    r(0) += TranslationX
1831 –                    r(1) += TranslationY
1832 –                    r = Commun.TransfertSketchToModel(swSketch, r)
1833 –
1834 –                    pt3(0) -= TranslationX
1835 –                    pt3(1) -= TranslationY
1836 –                    pt3(0) /= longueur : pt3(1) /= longueur
1837 –                    For i = 0 To 2
1838 –                        Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1839 –                        P(i, 0) += TranslationX
1840 –                        P(i, 1) += TranslationY
1841 –                    Next i
1842 –                    ReDim Ligne(7)
1843 –                    Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
1844 –                    Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
1845 –
1846 –                    swModel.CreateArc2(P(0, 0), P(0, 1), 0, P(1, 0), P(1, 1), 0, P(2, 0), P(2, 1), 0, -1) ' le dernier param est la direction.  1 ou -1
1847 –
1848 –            End Select
1849 –            MettreFI = True
1335  
1336          Else
1337              MsgBox("Section de poutre non reconnu!", MsgBoxStyle.Critical, "Commun.DessineSectionPoutre")
# Line 1863 | Line 1348 | Public Class SuperFace
1348  
1349      End Function
1350  
1351 <    Public Function SwFace() As SldWorks.Face2 ' retourne la première face de la liste (dans la partie traitement, ce sera la seule...)
1351 >    Public Function SwFace() As sldworks.Face2 ' retourne la première face de la liste (dans la partie traitement, ce sera la seule...)
1352          Return Me.lst_Faces.Item(0)
1353      End Function
1354  
1355 <    Public Function IsFaceInterne(ByRef swface As SldWorks.Face2) As Boolean
1356 <        Dim attr As SldWorks.Attribute
1357 <        Dim SwEnt As SldWorks.Entity
1355 >    Public Function IsFaceInterne(ByRef swface As sldworks.Face2) As Boolean
1356 >        Dim attr As sldworks.Attribute
1357 >        Dim SwEnt As sldworks.Entity
1358          SwEnt = swface
1359          attr = SwEnt.FindAttribute(DefAttrFaceInterne, 0)
1360          If attr Is Nothing Then Return False Else Return True
# Line 1880 | Line 1365 | Public Class SuperFace
1365      ''' </summary>
1366      ''' <returns>Un tableau de Edges</returns>
1367      ''' <remarks></remarks>
1368 <    Public Function GetAretes() As SldWorks.Edge()
1369 <        Dim face As SldWorks.Face2
1370 <        Dim arete As SldWorks.Edge = Nothing
1371 <        Dim temp2 As Collections.Generic.List(Of SldWorks.Edge)
1372 <        Dim lst As New Collections.Generic.List(Of SldWorks.Edge)
1368 >    Public Function GetAretes() As sldworks.Edge()
1369 >        Dim face As sldworks.Face2
1370 >        Dim arete As sldworks.Edge = Nothing
1371 >        Dim temp2 As Collections.Generic.List(Of sldworks.Edge)
1372 >        Dim lst As New Collections.Generic.List(Of sldworks.Edge)
1373  
1374          For Each face In Me.lst_Faces
1375              temp2 = GetArete1Face(face)
# Line 1896 | Line 1381 | Public Class SuperFace
1381          Return lst.ToArray
1382      End Function
1383  
1384 <    Private Function GetArete1Face(ByRef Face As SldWorks.Face2) As Collections.Generic.List(Of SldWorks.Edge)
1384 >    Private Function GetArete1Face(ByRef Face As sldworks.Face2) As Collections.Generic.List(Of sldworks.Edge)
1385          Dim vArete As Object
1386 <        Dim a As SldWorks.Edge
1387 <        Dim arete() As SldWorks.Edge
1388 <        Dim lst As New Collections.Generic.List(Of SldWorks.Edge)
1386 >        Dim a As sldworks.Edge
1387 >        Dim arete() As sldworks.Edge
1388 >        Dim lst As New Collections.Generic.List(Of sldworks.Edge)
1389  
1390          ReDim arete(Face.GetEdgeCount - 1)
1391          vArete = Face.GetEdges()
# Line 1913 | Line 1398 | Public Class SuperFace
1398      End Function
1399  
1400      Public Overrides Sub Selectionner(Optional ByVal Mark As Integer = 0, Optional ByRef append As Boolean = True)
1401 <        Dim swent As SldWorks.Entity
1402 <        Dim swface As SldWorks.Face2
1401 >        Dim swent As sldworks.Entity
1402 >        Dim swface As sldworks.Face2
1403  
1404          For Each swface In lst_Faces
1405              swent = swface
# Line 1930 | Line 1415 | Public Class SuperFace
1415      ''' <param name="Append"></param>
1416      ''' <remarks></remarks>
1417      Public Sub SelectionnerToutes(Optional ByRef Mark As Integer = 0, Optional ByRef Append As Boolean = True)
1418 <        Dim swFace As SldWorks.Face2
1418 >        Dim swFace As sldworks.Face2
1419  
1420 <        Dim swent As SldWorks.Entity
1420 >        Dim swent As sldworks.Entity
1421          If Append = False Then swModel.ClearSelection2(True)
1422          For Each swFace In Me.lst_Faces
1423              swent = swFace : swent.Select2(True, Mark)
# Line 1943 | Line 1428 | Public Class SuperFace
1428  
1429  
1430      Public Function Couleur(ByRef rouge As Double, ByRef Vert As Double, ByRef Bleu As Double, Optional ByVal Ambient As Double = 1, Optional ByVal Diffuse As Double = 1, Optional ByVal Specular As Double = 1, Optional ByVal Shininess As Double = 0.5, Optional ByVal Transparency As Double = 0, Optional ByVal Emission As Double = 0.2) As Integer
1946 –
1431          swModel.SelectedFaceProperties(RGB(rouge, Vert, Bleu), Ambient, Diffuse, Specular, Shininess, Transparency, Emission, False, "")
1948 –
1432          Return 1
1433      End Function
1434  
1435 <    Public Sub AjouterFace(ByRef face As SldWorks.Face2)
1436 <        Dim testface As SldWorks.Face2
1437 <        Dim faultentity As SldWorks.FaultEntity
1438 <        Dim swent As SldWorks.Entity
1435 >
1436 >    Public Sub AjouterFace(ByRef face As sldworks.Face2)
1437 >        Dim testface As sldworks.Face2
1438 >        Dim faultentity As sldworks.FaultEntity
1439 >        Dim swent As sldworks.Entity
1440  
1441          If Not Me.lst_Faces.Contains(face) Then Me.lst_Faces.Add(face)
1442  
1443          ' vérifier que les anciennes faces sont toujours ok...
1444 <        For Each testface In Me.lst_Faces
1445 <            faultentity = testface.Check
1446 <            If Not faultentity.Count = 0 Then ' on a un problème avec la face....
1447 <                lst_Faces.Remove(testface)
1448 <                Dim i As Integer
1449 <                For i = 0 To faultentity.Count
1450 <                    swent = faultentity.Entity(i)
1451 <                    If Not swent Is Nothing Then
1452 <                        swent.Select4(True, Nothing)
1453 <                    End If
1454 <                    Debug.Print("   Fault[" & i & "] = " & swent.errorCode(i))
1455 <                Next i
1456 <            End If
1457 <        Next testface
1444 >        'For Each testface In Me.lst_Faces
1445 >        '    faultentity = testface.Check
1446 >        '    If Not faultentity.Count = 0 Then ' on a un problème avec la face....
1447 >        '        If lst_Faces.Contains(testface) Then
1448 >        '            Try
1449 >        '                lst_Faces.Remove(testface)
1450 >        '            Catch ex As Exception
1451 >
1452 >        '            End Try
1453 >        '        End If
1454 >
1455 >        'Dim i As Integer
1456 >        'For i = 0 To faultentity.Count - 1
1457 >        '    swent = faultentity.Entity(i)
1458 >        '    If Not swent Is Nothing Then
1459 >        '        swent.Select4(True, Nothing)
1460 >        '    End If
1461 >        '    Debug.Print("   Fault[" & i & "] = " & swent.errorCode(i))
1462 >        'Next i
1463 >        'End If
1464 >        'Next testface
1465  
1466  
1467      End Sub
# Line 1996 | Line 1487 | Public Class SuperFace
1487      ''' </summary>
1488      ''' <returns></returns>
1489      ''' <remarks></remarks>
1490 <    Public Function GetFace() As SldWorks.Face2
1490 >    Public Function GetFace() As sldworks.Face2
1491          Return Me.SwFace
1492      End Function
1493  
# Line 2005 | Line 1496 | Public Class SuperFace
1496      ''' </summary>
1497      ''' <returns></returns>
1498      ''' <remarks></remarks>
1499 <    Public Function GetFaces() As SldWorks.Face2()
1499 >    Public Function GetFaces() As sldworks.Face2()
1500          Return Me.lst_Faces.ToArray
1501      End Function
1502  
# Line 2036 | Line 1527 | Public Class SuperFace
1527      ''' <param name="X"></param>
1528      ''' <param name="Y"></param>
1529      ''' <param name="Z"></param>
1530 <    ''' <returns>Vrai si l epoint est sur la face, faux sinon</returns>
1530 >    ''' <returns>Vrai si le point est sur la face, faux sinon</returns>
1531      ''' <remarks>Retourne X, Y et Z même si le point n'est pas sur la face (mais sur la surface) </remarks>
1532      Public Function Evaluer(ByRef U As Double, ByVal V As Double, ByRef X As Double, ByRef Y As Double, ByRef Z As Double) As Boolean
1533 <        Dim surf As SldWorks.Surface
1533 >        Dim surf As sldworks.Surface
1534          Dim vEv As Object, vpoint As Object
1535          Dim P(2) As Double
1536  
# Line 2064 | Line 1555 | Public Class SuperFace
1555      ''' <returns>Un tableau de 3 doubles correspondant à la normale</returns>
1556      ''' <remarks></remarks>
1557      Public Function Normale(ByRef X As Double, ByRef Y As Double, ByRef Z As Double) As Double()
1558 <        Dim surf As SldWorks.Surface
1558 >        Dim surf As sldworks.Surface
1559          Dim vtemp As Object
1560          Dim temp() As Double
1561          Dim sens As Boolean
# Line 2072 | Line 1563 | Public Class SuperFace
1563          surf = SwFace.GetSurface
1564          If surf.IsPlane Then vtemp = SwFace.Normal : temp = vtemp : Return temp ' si la face est plane alors c'est ok, sinon il faut travailler...
1565  
2075 –
1566          vtemp = surf.EvaluateAtPoint(X, Y, Z)
1567          ReDim temp(2)
2078 –
1568          ' la normale de la face pointe AWAY from the body
2080 –
1569          sens = SwFace.FaceInSurfaceSense()  'TRUE if face normal and surface normal are in the opposite direction and FALSE if they are in the same direction
1570  
2083 –
1571          If sens Then ' on doit inverser
1572              temp(0) = -vtemp(0) : temp(1) = -vtemp(1) : temp(2) = -vtemp(2)
1573          Else
# Line 2090 | Line 1577 | Public Class SuperFace
1577  
1578      End Function
1579  
1580 <
1581 <    Public Sub MettreAttributFaceInterne(Optional ByRef Valeur As Double = 0)
1580 >    ''' <summary>
1581 >    ''' Met un attribut de face interne
1582 >    ''' </summary>
1583 >    ''' <param name="face">La face sur laquelle mettre l'attribut</param>
1584 >    ''' <param name="Valeur">La taille de maille suggérée</param>
1585 >    ''' <param name="poutre">Si vrai alors on a une poutre, sinon une coque</param>
1586 >    ''' <returns>Le numéro de l'attribut (si jamais c'est important)</returns>
1587 >    ''' <remarks>Attention au signe de la valeur</remarks>
1588 >    Public Function MettreAttributFaceInterne(ByRef face As sldworks.Face2, Optional ByRef Valeur As Double = 0, Optional ByVal poutre As Boolean = True) As Integer
1589          Dim no As Integer = 0
1590          Dim nom As String = "FaceInterne" & no
1591 <        Dim swent As SldWorks.Entity
1592 <        Dim attr As SldWorks.Attribute
1591 >        Dim swent As sldworks.Entity
1592 >        Dim attr As sldworks.Attribute
1593 >        Dim p As sldworks.Parameter
1594 >
1595 >        swent = face 'Me.SwFace
1596  
2100 –        swent = Me.SwFace
1597          attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
1598 <        If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, SwFace, nom, 0, 2) ' 0 = swThisconfig
1598 >        If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, face, nom, 0, 2) ' 0 = swThisconfig
1599          While attr Is Nothing
1600              no += 1
1601              nom = "FaceInterne" & CStr(no)
1602 <            attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, SwFace, nom, 0, 2)
1602 >            attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, face, nom, 0, 2)
1603          End While
1604 +        p = attr.GetParameter("FI")
1605 +        p.SetDoubleValue(Valeur)
1606 +
1607 +        p = attr.GetParameter("Po")
1608 +        If poutre Then
1609 +            p.SetDoubleValue(0) ' poutre
1610 +        Else
1611 +            p.SetDoubleValue(1) ' coque
1612 +        End If
1613 +
1614 +
1615          GererDossiers("FaceInternes", nom)
1616 +        Return no
1617 +    End Function
1618 +
1619 +    ''' <summary>
1620 +    ''' Si la face est une face interne,alors on écrit les points POG dans le fichier
1621 +    ''' </summary>
1622 +    ''' <remarks></remarks>
1623 +    Public Sub MettrePointSurPOG(ByVal fichier As System.IO.StreamWriter)
1624 +        ' 2 - Si la face a un attribut de faceInterne on:
1625 +        Dim ENG As Double = Commun.ÉcartNodal
1626 +        Dim EcartSouhaite As Double
1627 +        Dim ratio As Double
1628 +
1629 +
1630 +        If Me.PossedeAttributFaceInterne Then
1631 +            ' 2.1 Détermine l'écart nodal à cette face ( en fait, le ratio... )
1632 +
1633 +            ' là on a 2 options,
1634 +            ' a) on utilise le rayon hydraulique: 4* Surface / Périmètre
1635 +            EcartSouhaite = Me.GrosseurMailleFaceInterne ' 4 * Me.Aire / Me.Perimetre
1636 +            ratio = EcartSouhaite / ENG
1637 +
1638 +
1639 +            If ratio > 0.75 Then ratio = 0.75 ' ?!? on s'assure d'avoir un minimum de rafinement...
1640 +            ' b) On analyse la tessellation et on prend la plus petite longueur de triangle...
1641 +
1642 +            ' 2.2 Créé une série de points [ sur chaque point de la tessellation   :-) ]  mais là on va avoir un tas de doubles... Update.  La tessellation n emarche pas, sur des faces «carrées» il y a des zones trop vides
1643 +            ' On va mettre des points sur le contour des faces.  un point va automatiquement se retrouver au milieu
1644 +
1645 +            Dim objArete As Object = Me.SwFace.GetEdges
1646 +            Dim points As New Collections.Generic.List(Of Point)
1647 +            Dim p As Point
1648 +            Dim x, y, z As Double
1649 +
1650 +
1651 +            For Each swArete As sldworks.Edge In objArete
1652 +                Dim e As New SuperArete(swArete, True)
1653 +                Dim LongueurArete As Double = e.Longueur
1654 +                Dim nbSeg As Integer = Int(LongueurArete / EcartSouhaite / 2) : If nbSeg < 2 Then nbSeg = 2
1655 +                Dim dt As Double = (e.GetTMax - e.GetTMin) / nbSeg
1656 +                Dim T As Double = e.GetTMin
1657 +
1658 +
1659 +                ' les points sur les arètes
1660 +
1661 +                For s As Integer = 1 To nbSeg - 1
1662 +                    T += dt
1663 +                    e.Evaluer(T, x, y, z)
1664 +                    p = New Point(x, y, z) : points.Add(p)
1665 +                Next s
1666 +
1667 +
1668 +
1669 +                ' les points sur les sommets
1670 +                Dim swSommets() As sldworks.Vertex = Me.GetSommets
1671 +                Dim es As SuperSommet
1672 +                For Each sommet As sldworks.Vertex In swSommets
1673 +                    es = New SuperSommet(sommet, True)
1674 +                    p = New Point(es.X, es.Y, es.Z) : points.Add(p)
1675 +                Next
1676 +                e = Nothing
1677 +                es = Nothing
1678 +
1679 +            Next
1680  
1681 +            For Each p In points
1682 +                ' 2.3 enregistre ces points dans le fichier.
1683 +                fichier.WriteLine(CStr(p) & " " & ratio & " " & "4" & " " & "0")
1684 +            Next p
1685 +            ENG = 1 ' pour y mettre un point d'arrêt
1686 +        End If
1687      End Sub
1688  
1689  
1690 +    ''' <summary>
1691 +    ''' Retourne un tableau de swSommets
1692 +    ''' </summary>
1693 +    ''' <returns></returns>
1694 +    ''' <remarks></remarks>
1695 +    Public Function GetSommets() As sldworks.Vertex()
1696 +        Dim lst_sommets As New Collections.Generic.List(Of sldworks.Vertex)
1697 +        Dim swSommet As sldworks.Vertex
1698 +        Dim objArete As Object = Me.SwFace.GetEdges()
1699 +
1700 +        For Each arete As sldworks.Edge In objArete
1701 +            swSommet = arete.GetStartVertex() : If swSommet Is Nothing Then Continue For
1702 +            If Not lst_sommets.Contains(swSommet) Then lst_sommets.Add(swSommet)
1703 +            swSommet = arete.GetEndVertex()
1704 +            If Not lst_sommets.Contains(swSommet) Then lst_sommets.Add(swSommet)
1705 +        Next arete
1706 +        Return lst_sommets.ToArray
1707 +    End Function
1708 +
1709 +
1710 +    ''' <summary>
1711 +    ''' Function qui donne la grosseur des maille que l'on aimerait avoir pour
1712 +    ''' </summary>
1713 +    ''' <returns></returns>
1714 +    ''' <remarks></remarks>
1715 +    Public Function GrosseurMailleFaceInterne() As Double
1716 +        Dim swEnt As sldworks.Entity
1717 +        Dim attr As sldworks.Attribute
1718 +        swEnt = Me.SwFace
1719 +        attr = swEnt.FindAttribute(Intersections.DefAttrFaceInterne, 0)
1720 +        If attr Is Nothing Then Return Nothing
1721 +        Dim p As sldworks.Parameter = attr.GetParameter("FI")
1722 +        Return p.GetDoubleValue
1723 +    End Function
1724 +
1725 +    ''' <summary>
1726 +    ''' Retourne vrai si la face a un attribut de face interne.
1727 +    ''' </summary>
1728 +    ''' <returns></returns>
1729 +    ''' <remarks></remarks>
1730 +    Public Function PossedeAttributFaceInterne() As Boolean
1731 +        Dim swEnt As sldworks.Entity
1732 +        Dim attr As sldworks.Attribute
1733 +        swEnt = Me.SwFace
1734 +        attr = swEnt.FindAttribute(Intersections.DefAttrFaceInterne, 0)
1735 +        If attr Is Nothing Then Return False Else Return True
1736 +    End Function
1737 +
1738 +
1739 +    ''' <summary>
1740 +    ''' Retourne le périmètre de la face
1741 +    ''' </summary>
1742 +    ''' <returns></returns>
1743 +    ''' <remarks>Attention, c'est une approximation!!!</remarks>
1744 +    Public Function Perimetre() As Double
1745 +        Dim objArete As Object = Me.SwFace.GetEdges
1746 +        'Dim swAretes() As sldworks.Edge = objArete
1747 +        Dim longueur As Double
1748 +
1749 +        For Each swArete As sldworks.Edge In objArete
1750 +            Dim e As New SuperArete(swArete, True)
1751 +            longueur += e.Longueur()
1752 +        Next
1753 +        Return longueur
1754 +    End Function
1755 +
1756 +
1757 +    ''' <summary>
1758 +    ''' Retourne la surface (l'aire) de la face
1759 +    ''' </summary>
1760 +    ''' <returns></returns>
1761 +    ''' <remarks></remarks>
1762 +    Public Function Aire() As Double
1763 +        Return Me.SwFace.GetArea
1764 +    End Function
1765 +
1766 +    ''' <summary>
1767 +    ''' Retourne le nombre d'arètes contenues dans la superface
1768 +    ''' </summary>
1769 +    ''' <value></value>
1770 +    ''' <returns></returns>
1771 +    ''' <remarks></remarks>
1772 +    Public ReadOnly Property GetNbAretes() As Integer
1773 +        Get
1774 +            Dim nb As Integer
1775 +            Dim lstFaces() As sldworks.Face2 = Me.SwFace
1776 +            For Each swFace As sldworks.Face2 In lstFaces
1777 +                nb += swFace.GetEdgeCount
1778 +            Next
1779 +            Return nb
1780 +        End Get
1781 +    End Property
1782 +
1783 +    Public Function GetSurface() As sldworks.Surface
1784 +        Return Me.GetFace.GetSurface
1785 +    End Function
1786 +
1787 +
1788 +
1789   End Class

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines