ViewVC Help

View File | Revision Log | Show Annotations | View Changeset | Root Listing

root/REPOS_ERICCA/magicsld/SuperFace.vb

Comparing magicsld/SuperFace.vb (file contents):
Revision 48 by bournival, Wed Aug 22 21:18:12 2007 UTC vs.
Revision 130 by bournival, Wed Jul 30 21:26:03 2008 UTC

#	Line 42 | 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 59 | 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 95 | 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 114 | Line 114 | Public Class SuperFace
114		'  3 faire une mini-poutre entre les 2
115
116		swModel.Insert3DSketch2(True)
117	–	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 394 | Line 396 | Public Class SuperFace
396		End Sub
397
398
399	<	' sub qui découpe les bords de la face.
398	<	Friend Sub CoupeCote(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre)
399	<	Dim pt3() As Double, pt3Original() As Double
400	<	Dim base(2) As Double, baseOriginal(2) As Double
401	<	Dim swEnt As SldWorks.Entity
402	<	Dim Directionnel As Boolean, Flip As Boolean
403	<	Dim planReference As SldWorks.RefPlane = Nothing
404	<	Dim sketchline As SldWorks.SketchSegment
405	<	Dim swSketch As SldWorks.Sketch
406	<	Dim DemiLargeur As Double
407	<	Dim g As Integer
408	<	Dim Face(1) As SldWorks.Face2
409	<	Dim PlanEntity As SldWorks.Entity = Nothing
410	<	Dim r(2) As Double
411	<	Dim sk(1) As Double
412	<	pt3Original = poutre.GetPoint3
413	<
414	<
415	<	swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
416	<	'swModel.SetAddToDB(True)
417	<	'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
418	<
419	<	Dim vArete As Object
420	<	Dim cut As Double
421	<
422	<	If Me.estPlan Then
423	<	' la coque est plane, on met une esquisse dessus.#
424	<	PlanEntity = Me.SwFace
425	<
426	<	ElseIf Me.estCylindre Then
427	<	' on doit créer un plan de référence...
428	<
429	<	ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
430	<	Dim vEdge As Object
431	<	Dim i As Integer
432	<	Dim swArete2() As SldWorks.Edge
433	<	Dim swSommet As SldWorks.Vertex
434	<
435	<	vEdge = Me.SwFace.GetEdges
436	<	swArete2 = vEdge
437	<	swModel.ClearSelection2(True)
438	<
439	<	While planReference Is Nothing
440	<	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
441	<	swSommet = swArete2(i).GetStartVertex()
442	<	swEnt = swSommet
443	<	swEnt.Select4(False, Nothing)
444	<	swArete2(i + 1).GetStartVertex()
445	<	swEnt = swSommet
446	<	swEnt.Select4(True, Nothing)
447	<	swArete2(i + 2).GetStartVertex()
448	<	swEnt = swSommet
449	<	swEnt.Select4(True, Nothing)
450	<	i += 1
451	<	planReference = swModel.CreatePlaneThru3Points3(False)
452	<	PlanEntity = planReference
453	<	End While
454	<
455	<
456	<	Else ' la face est une spline
457	<	MsgBox("Dans coupeCoté, la face est un type de surface qui n'est pas encore traité")
458	<	End If
459	<
460	<
461	<	baseOriginal(0) = inter.x : baseOriginal(1) = inter.y : baseOriginal(2) = inter.z
462	<
463	<
464	<	Dim Psi As Double
465	<	Dim u(2) As Double, v(2) As Double, usketch(2) As Double, vsketch(2) As Double
466	<	Dim Arete As SldWorks.Edge = Nothing
467	<	Dim retval As Object
468	<	u = poutre.GetOrientation(inter.x, inter.y, inter.z)
469	<
470	<
471	<	vArete = Me.SwFace.GetEdges
472	<
473	<	For Each Arete In vArete
474	<	If Commun.Distance(Arete, inter.x, inter.y, inter.z) < Epsilon Then Exit For
475	<	Next
476	<
477	<	retval = Arete.GetClosestPointOn(inter.x, inter.y, inter.z)
478	<	retval = Arete.Evaluate(retval(3))
479	<	v(0) = retval(3) : v(1) = retval(4) : v(2) = retval(5)
480	<
481	<
482	<
483	<
484	<	For g = 0 To 1
485	<
486	<	PlanEntity.Select(False)
487	<	swModel.InsertSketch2(True)
488	<	swSketch = swModel.GetActiveSketch2
489	<
490	<	pt3 = Commun.TransfertModelSketch(swSketch, pt3Original)
491	<	usketch = Commun.TransfertModelSketch(swSketch, u)  ' on les met dans le plan du sketch
492	<	vsketch = Commun.TransfertModelSketch(swSketch, v)
493	<	base = Commun.TransfertModelSketch(swSketch, baseOriginal)
494	<	Psi = Outils_Math.cosdir(usketch, vsketch)
495	<
496	<	Dim a As Double, b As Double
497	<	'longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
498	<	'If pt3(1) = 0 Then a = 999999999999 Else a = Math.Abs(poutre.GetD2() * longueur / pt3(1))
499	<	'If pt3(0) = 0 Then b = 999999999999 Else b = Math.Abs(poutre.GetD1() * longueur / pt3(0))
500	<	' À revoir. Si le plan est un cylindre ça marche plus. sans compter l'épaisseur de la poutre.
501	<	' pour l'instant je prend la plus prtite valeur...
502	<	a = poutre.GetD1
503	<	b = poutre.GetD2
504	<	DemiLargeur = Math.Min(a, b)
505	<	cut = DemiLargeur / Math.Sin(Pi / 2 - Psi)
506	<
507	<
508	<	Dim P1(1) As Double
509	<	Dim P2(1) As Double
510	<	Dim P3(1) As Double
511	<	Dim P4(1) As Double
512	<	Dim Ptest(2) As Double
513	<
514	<
515	<	If g = 0 Then
516	<	P1(0) = -cut
517	<	P1(1) = -cut '* mult ' 0
518	<	P2(0) = 0
519	<	P2(1) = -cut '* mult ' 0
520	<	P3(0) = 0
521	<	P3(1) = cut   'Intersections.Taille mult
522	<	P4(0) = -cut
523	<	P4(1) = cut   'Intersections.Taille mult
524	<	sk(0) = -Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
525	<
526	<	Else
527	<	P1(0) = 0
528	<	P1(1) = -cut '* mult '0
529	<	P2(0) = +cut
530	<	P2(1) = -cut '* mult '0
531	<	P3(0) = +cut
532	<	P3(1) = cut  'Intersections.Taille mult
533	<	P4(0) = 0
534	<	P4(1) = cut  'Intersections.Taille mult
535	<	sk(0) = Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
536	<
537	<	End If
538	<
539	<	P1 = Outils_Math.Rotation2D(vsketch, P1)
540	<	P2 = Outils_Math.Rotation2D(vsketch, P2)
541	<	P3 = Outils_Math.Rotation2D(vsketch, P3)
542	<	P4 = Outils_Math.Rotation2D(vsketch, P4)
543	<	sk = Outils_Math.Rotation2D(vsketch, sk)
544	<
545	<	sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P2(0) + base(0), P2(1) + base(1), 0)
546	<	sketchline = swModel.CreateLine2(P2(0) + base(0), P2(1) + base(1), 0, P3(0) + base(0), P3(1) + base(1), 0)
547	<	sketchline = swModel.CreateLine2(P3(0) + base(0), P3(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)
548	<	sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)
549	<
550	<	swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
551	<	swModel.ClearSelection2(True)
552	<	swEnt = Me.SwFace : swEnt.Select2(False, 1)
553	<	swEnt = swSketch : swEnt.Select2(True, 4)
554	<
555	<	swModel.InsertSplitLineProject(Directionnel, Flip)
556	<	r = Commun.TransfertSketchToModel(swSketch, sk)
557	<	Face(g) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference)
558	<	'If Face(g) Is Nothing Then
559	<	'swSketch.Select(False)
560	<	'swModel.EditDelete()
561	<	'End If
562	<
563	<	Next g
564	<
565	<
566	<
567	<	' mettre les mini-poutres
568	<	Dim vEdge2 As Object
569	<	Dim swArete As SldWorks.Edge
570	<	Dim vPoint As Object
571	<	Dim Mini1 As SldWorks.Edge = Nothing, Mini2 As SldWorks.Edge = Nothing
572	<
573	<
574	<	' 1 - trouver les 2 arrères dont l'orientation est la même (ou l'inverse) que le v
575	<	For g = 0 To 1
576	<	If Not Face(g) Is Nothing Then
577	<	vEdge2 = Face(g).GetEdges()
578	<
579	<
580	<	' construire u
581	<	For Each swArete In vEdge2
582	<	If Commun.Distance(swArete, inter.x, inter.y, inter.z) < Epsilon Then
583	<	' l'arête touche à l'intersection,
584	<	vPoint = swArete.GetClosestPointOn(inter.x, inter.y, inter.z)
585	<	vPoint = swArete.Evaluate(vPoint(3))
586	<	u(0) = vPoint(3) : u(1) = vPoint(4) : u(2) = vPoint(5)
587	<
588	<	If Outils_Math.CompareSens(v, u) Then
589	<	' l'arète doit être une mini-poutre
590	<	If Mini1 Is Nothing Then Mini1 = swArete : Exit For Else Mini2 = swArete : Exit For
591	<	End If
592	<	End If
593	<
594	<	Next
595	<
596	<	End If
597	<	Next
598	<
599	<	swEnt = Mini1
600	<	If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
601	<
602	<	If Not Mini2 Is Nothing Then
603	<	swEnt = Mini2
604	<	If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
605	<	End If
606	<
607	<	swModel.SetInferenceMode(True) '
608	<	'swModel.SetAddToDB(False)
609	<	'swModel.SetDisplayWhenAdded(True) '
610	<	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)
615	–	Dim swEnt As SldWorks.Entity
616	–	Dim swSketchSegment As SldWorks.SketchSegment
617	–	Dim vSketchSegments As Object
618	–	Dim swSketch As SldWorks.Sketch
619	–	Dim faceinterne(1) As SldWorks.Face2
620	–	Dim swPlan As SldWorks.RefPlane = Nothing
621	–	Dim b As Integer
622	–	Dim swSommet As SldWorks.Vertex
623	–	Dim i As Integer
624	–
625	–	swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
626	–
627	–	' faut découper toutes les faces de la liste si elles ne sont pas des faces internes
628	–	Dim MeFace As SldWorks.Face2
629	–	Dim ListeFace() As SldWorks.Face2
630	–	ReDim ListeFace(Me.lst_Faces.Count - 1)
631	–
632	–	For i = 1 To Me.lst_Faces.Count
633	–	ListeFace(i - 1) = Me.lst_Faces.Item(i)
634	–	Next
635	–
636	–	For Each MeFace In ListeFace
637	–
638	–	If Me.estPlan Then
639	–	swEnt = MeFace
640	–	swEnt.Select(False)
641	–	swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
642	–	swEnt.Select(False)
643	–	swModel.InsertSketch2(True)
644	–
645	–	swPlan = swModel.CreatePlaneAtOffset3(0, False, False)
646	–
647	–	ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
648	–	If b = 0 Then
649	–	Dim vEdge As Object
650	–
651	–
652	–	vEdge = MeFace.GetEdges
653	–	swModel.ClearSelection2(True)
654	–	While swPlan Is Nothing
655	–	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
656	–	swSommet = vEdge(i).GetStartVertex()
657	–	swEnt = swSommet
658	–	swEnt.Select4(False, Nothing)
659	–	swSommet = vEdge(i + 1).GetStartVertex()
660	–	swEnt = swSommet
661	–	swEnt.Select4(True, Nothing)
662	–	swSommet = vEdge(i + 2).GetStartVertex()
663	–	swEnt = swSommet
664	–	swEnt.Select4(True, Nothing)
665	–	i += 1
666	–	swPlan = swModel.CreatePlaneThru3Points3(False)
667	–
668	–	End While
669	–	End If
670	–	swEnt = swPlan
671	–	swEnt.Select(False)
672	–	swModel.InsertSketch2(True)
673	–
674	–	Else
675	–	MsgBox("Dans coupeLong, on a un type de face qui n'est pas encore traité")
676	–
677	–	End If
678	–
679	–
680	–	swSketch = swModel.GetActiveSketch2
681	–
682	–	swEnt = poutre.swArete
683	–	swEnt.Select(False)
404
685	–	' créer la ligne de  «conversion de entités»
686	–	swModel.SketchUseEdge2(False)
405
406	<	vSketchSegments = swSketch.GetSketchSegments()
407	<	swSketchSegment = vSketchSegments(0)
408	<	swSketchSegment.Select2(False, 1)  'on sélectionne l'arète de poutre...
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
692	–	Dim x As Double, y As Double, z As Double
693	–	Commun.GetMidPointSegment(swSketchSegment, x, y, z)
694	–
695	–
696	–	' sketchoffset doit avoir un mark de 1 pour l'objet à offsetter.  Une valeur négative inverse la direction
697	–	swModel.SketchManager.SketchOffset(poutre.GetD2, False, 0, 0, 0, 0)
698	–	' pour rendre le modèle plus beau, on peut enlever la contrainte de offset et laisser solidworks mettre des contraintes automatiques...
699	–
700	–	Dim retval As Object
701	–	Dim skPointA1 As SldWorks.SketchPoint = Nothing, skPointA2 As SldWorks.SketchPoint = Nothing, skPointB1 As SldWorks.SketchPoint = Nothing, skPointB2 As SldWorks.SketchPoint = Nothing
702	–
703	–	vSketchSegments = swSketch.GetSketchSegments()
704	–	swSketchSegment = vSketchSegments(1)
705	–
706	–
707	–	Select Case swSketchSegment.GetType()
708	–	Case 0 ' on a une ligne
709	–	Dim sketchline As SldWorks.SketchLine
710	–	sketchline = swSketchSegment
711	–	skPointA1 = sketchline.GetStartPoint2
712	–	skPointA2 = sketchline.GetEndPoint2()
713	–	Case 1 ' arc
714	–	Dim arc As SldWorks.SketchArc
715	–	arc = swSketchSegment
716	–	skPointA1 = arc.GetStartPoint
717	–	skPointA2 = arc.GetEndPoint2
718	–	Case 2 ' ellipse
719	–	Dim sketchEllipse As SldWorks.SketchEllipse
720	–	sketchEllipse = swSketchSegment
721	–	skPointA1 = sketchEllipse.GetStartPoint2
722	–	skPointA2 = sketchEllipse.GetEndPoint2
723	–	Case 3 ' spline
724	–	Dim spline As SldWorks.SketchSpline
725	–	Dim pts() As SldWorks.SketchPoint
726	–	spline = swSketchSegment
727	–	retval = spline.GetPoints2()
728	–	pts = retval
729	–	skPointA1 = pts(0)
730	–	skPointA2 = pts(UBound(pts))
731	–	Case 5 ' parabole (le 4 est du texte)
732	–	Dim para As SldWorks.SketchParabola
733	–	para = swSketchSegment
734	–	skPointA1 = para.GetStartPoint2
735	–	skPointA2 = para.GetEndPoint2
736	–	End Select
737	–
738	–	swSketchSegment = vSketchSegments(0)
739	–	Select Case swSketchSegment.GetType()
740	–	Case 0 ' on a une ligne
741	–	Dim sketchline As SldWorks.SketchLine
742	–	sketchline = swSketchSegment
743	–	skPointB1 = sketchline.GetStartPoint2
744	–	skPointB2 = sketchline.GetEndPoint2()
745	–	Case 1 ' arc
746	–	Dim arc As SldWorks.SketchArc
747	–	arc = swSketchSegment
748	–	skPointB1 = arc.GetStartPoint
749	–	skPointB2 = arc.GetEndPoint2
750	–	Case 2 ' ellipse
751	–	Dim sketchEllipse As SldWorks.SketchEllipse
752	–	sketchEllipse = swSketchSegment
753	–	skPointB1 = sketchEllipse.GetStartPoint2
754	–	skPointB2 = sketchEllipse.GetEndPoint2
755	–	Case 3 ' spline
756	–	Dim spline As SldWorks.SketchSpline
757	–	Dim pts() As SldWorks.SketchPoint
758	–	spline = swSketchSegment
759	–	retval = spline.GetPoints2()
760	–	pts = retval
761	–	skPointB1 = pts(0)
762	–	skPointB2 = pts(UBound(pts))
763	–	Case 5 ' parabole (le 4 est du texte)
764	–	Dim para As SldWorks.SketchParabola
765	–	para = swSketchSegment
766	–	skPointB1 = para.GetStartPoint2
767	–	skPointB2 = para.GetEndPoint2
768	–	End Select
769	–
770	–	' création des 2 lignes pour fermer le sketch.
771	–	swModel.CreateLine2(skPointA1.X, skPointA1.Y, 0, skPointB1.X, skPointB1.Y, 0)
772	–	swModel.CreateLine2(skPointA2.X, skPointA2.Y, 0, skPointB2.X, skPointB2.Y, 0)
773	–
774	–
775	–	Dim x2 As Double, y2 As Double, z2 As Double ' le midpoint de la poutre
776	–	Dim x3 As Double, y3 As Double, z3 As Double ' le midpoint de la poutre
777	–
778	–	swSketchSegment = vSketchSegments(0) ' le midpoint d'une poutre
779	–	Commun.GetMidPointSegment(swSketchSegment, x2, y2, z2)
780	–
781	–	swSketchSegment = vSketchSegments(1) ' le midpoint de l'autre poutre
782	–	Commun.GetMidPointSegment(swSketchSegment, x3, y3, z3)
783	–
784	–	Dim sk(1) As Double, r(2) As Double
785	–	sk(0) = (x3 + x2) / 2
786	–	sk(1) = (y3 + y2) / 2
787	–	r = Commun.TransfertSketchToModel(swSketch, sk)
788	–
789	–	swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
790	–	swModel.ClearSelection2(True)
791	–	swEnt = MeFace : swEnt.Select2(False, 1)
792	–	swEnt = swSketch : swEnt.Select2(True, 4)
793	–
794	–	swModel.InsertSplitLineProject(False, False)
795	–
796	–	Me.Flag = 20 ' pour dire que l'on a un coupeLong
797	–	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
798	–	Me.Flag = 0
799	–
800	–	'If faceinterne(b) Is Nothing Then
801	–	'swEnt = swSketch
802	–	'swEnt.Select(False)
803	–	'swModel.EditDelete()
804	–	'End If
805	–
806	–
807	–
808	–	' reste à updater, on doit ajouter de 2 à 4 mini-poutres
809	–	'Dim vEdges As Object
810	–	'Dim Arete As SldWorks.Edge
811	–	'Dim vFaces As Object
812	–	'Dim aretePoutre As SldWorks.Edge
813	–
814	–
815	–	''For b = 0 To 1
816	–	''If Not faceinterne(b) Is Nothing Then
817	–	'b = 0
818	–	'While faceinterne(b) Is Nothing
819	–	'    b += 1
820	–	'End While
821	–
822	–	'vEdges = faceinterne(b).GetEdges
823	–	'For Each Arete In vEdges
824	–	'    If Distance(Arete.GetStartVertex, inter.x, inter.y, inter.z) < Epsilon Then swSommet = Arete.GetStartVertex : Exit For
825	–	'    If Distance(Arete.GetEndVertex, inter.x, inter.y, inter.z) < Epsilon Then swSommet = Arete.GetEndVertex : Exit For
826	–	'Next
827	–
828	–	'Dim T As Double
829	–	'Dim xyz(2) As Double
830	–	'Dim g As Integer
831	–	'Dim courbe As SldWorks.Curve
832	–
833	–	'T = poutre.GetT(inter.x, inter.y, inter.z)
834	–
835	–	'vEdges = swSommet.GetEdges
836	–
837	–	'T -= 10000 * Epsilon
838	–
839	–	'For g = 0 To UBound(vEdges) ' boucle pas optimisée en vitesse
840	–	'    Arete = vEdges(g)
841	–	'    If poutre.Evaluer(T, xyz) Then
842	–	'        courbe = Arete.GetCurve
843	–	'        If Distance(courbe, xyz(0), xyz(1), xyz(2)) < Epsilon Then aretePoutre = Arete
844	–	'    ElseIf poutre.Evaluer(T + 20000 * Epsilon, xyz) Then
845	–	'        courbe = Arete.GetCurve
846	–	'        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.
847	–	'    End If
848	–	'Next g
849	–
850	–
851	–	'If aretePoutre Is Nothing Then
852	–	'    ' putain d'enfoiré de merde!!!! on trouve pas la courbe de la poutre. alors on sort avec dignité!
853	–	'    Exit Sub
854	–	'    ' anyway on avait dit en réunion de ne pas mettre de minipoutres...
855	–	'End If
856	–
857	–
858	–	'' 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.
859	–	'Dim swBoucle As SldWorks.Loop2
860	–	'Dim AreteAvant As SldWorks.Edge, AreteSuivant As SldWorks.Edge, areteTest As SldWorks.Edge
861	–	'Dim varete As Object
862	–	'Dim Mini1 As SldWorks.Edge, Mini2 As SldWorks.Edge, Mini3 As SldWorks.Edge, Mini4 As SldWorks.Edge
863	–
864	–	'Dim j As Integer
865	–
866	–	'If Not faceinterne(0) Is Nothing Then
867	–	'    swBoucle = faceinterne(0).GetFirstLoop ' devrait y en avoir juste une...
868	–	'    varete = swBoucle.GetEdges()
869	–
870	–	'    For j = 0 To UBound(varete)
871	–	'        areteTest = varete(j)
872	–	'        If areteTest Is aretePoutre Then
873	–	'            If j <> 0 Then Mini1 = varete(j - 1) Else Mini1 = varete(UBound(varete))
874	–	'            If j <> UBound(varete) Then Mini2 = varete(j + 1) Else Mini2 = varete(0)
875	–	'        End If
876	–	'    Next j
877	–	'End If
878	–
879	–	'If Not faceinterne(1) Is Nothing Then
880	–	'    swBoucle = faceinterne(1).GetFirstLoop ' devrait y en avoir juste une...
881	–	'    varete = swBoucle.GetEdges()
882	–
883	–	'    For j = 0 To UBound(varete)
884	–	'        areteTest = varete(j)
885	–	'        If areteTest Is aretePoutre Then
886	–	'            If j <> 0 Then Mini3 = varete(j - 1) Else Mini3 = varete(UBound(varete))
887	–	'            If j <> UBound(varete) Then Mini4 = varete(j + 1) Else Mini4 = varete(0)
888	–	'        End If
889	–	'    Next j
890	–	'End If
891	–	'If Not Mini1 Is Nothing Then
892	–	'    swEnt = Mini1
893	–	'    If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
894	–	'End If
895	–
896	–	'If Not Mini2 Is Nothing Then
897	–	'    swEnt = Mini2
898	–	'    If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
899	–	'End If
900	–
901	–	'If Not Mini3 Is Nothing Then
902	–	'    swEnt = Mini3
903	–	'    If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
904	–	'End If
905	–
906	–	'If Not Mini4 Is Nothing Then
907	–	'    swEnt = Mini4
908	–	'    If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
909	–	'End If
910	–	Next MeFace
911	–
912	–
913	–	swModel.SetInferenceMode(True) ' ne pas mettre de contraintes par défaut
914	–	'swModel.SetAddToDB(False)
915	–	'swModel.SetDisplayWhenAdded(True) ' accélérer les performances
591
592		End Sub
593
594
920	–	' sub qui coupe la face normalement, avec un X.... [cas #1]
921	–	Friend Sub CoupeX(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre)
922	–
923	–	Dim swEnt As SldWorks.Entity = Nothing
924	–	Dim Directionnel As Boolean, Flip As Boolean
925	–	Dim Faces(3) As SldWorks.Face2
926	–	Dim r(2) As Double
927	–	Dim LaSurface As SldWorks.Surface
928	–	Dim sens As Boolean
929	–	Dim p(2) As Double
930	–	Dim retour() As Double
931	–
932	–	swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
933	–	'swModel.SetAddToDB(True)
934	–	'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
935	–
936	–
937	–	' l'idée est de sélectionner le point et l'arète puis d'utiliser CreatePlanePerCurveAndPassPoint3
938	–	Dim planReference As SldWorks.RefPlane
939	–	Dim swsketch As SldWorks.Sketch
940	–	Dim swSommet As SldWorks.Vertex, swSommet2 As SldWorks.Vertex
941	–	Dim pointdeb(2) As Double, pointfin(2) As Double
942	–
943	–	'swModel.Extension.SelectByID2("", "POINTREF", inter.x, inter.y, inter.z, False, 0, Nothing, 0)
944	–	' faut vraiment sélectionner le bon point...
945	–	swSommet = poutre.swArete.GetStartVertex()
946	–	swSommet2 = poutre.swArete.GetEndVertex()
947	–	If swSommet Is Nothing Then
948	–	MsgBox("On a un cercle ou courbe sans sommets, dans coupeX, pas encore traité.  Ne peut pas mettre un plan si pas de sommet")
949	–	Else
950	–	If Distance(swSommet, inter.x, inter.y, inter.z) < Epsilon Then
951	–	swEnt = swSommet
952	–	ElseIf Distance(swSommet2, inter.x, inter.y, inter.z) < Epsilon Then
953	–	swEnt = swSommet2
954	–	Else
955	–	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")
956	–	End If
957	–	End If
958	–
959	–	swEnt.Select4(False, Nothing)
960	–	swEnt = poutre.swArete
961	–	swEnt.Select(True)
962	–
963	–	If Me.estPlan Or Me.estFauxPlan(inter.x, inter.y, inter.z) Then
964	–	' 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
965	–	planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
966	–	Directionnel = False
967	–	Flip = False
968	–	ElseIf Me.estCylindre Then
969	–	' 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é.
970	–	Dim PlanDessus As SldWorks.RefPlane
971	–	Dim Rayon As Double, L As Double, B As Double, phi As Double, dist As Double, temp1 As Double, temp2 As Double
972	–	Dim u(2) As Double, v(2) As Double
973	–	PlanDessus = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
974	–	temp1 = poutre.GetD1
975	–	temp2 = poutre.GetD2
976	–	L = Math.Sqrt(temp1 * temp1 + temp2 * temp2)
977	–	Rayon = Me.GetRayonCylindre()
978	–	u = poutre.GetOrientation(inter.x, inter.y, inter.z)
979	–	v = Me.GetNormale(inter.x, inter.y, inter.z)
980	–	phi = -(Math.Acos(Outils_Math.cosdir(u, v)))
981	–	B = Math.Abs(L / 2 * Math.Sin(phi))
982	–	dist = Rayon - Math.Sqrt(Rayon * Rayon - ((L / 2) * (L / 2))) + B
983	–	If dist < 0 Then MsgBox("Gros problème pour couper le cylindre, la poutre est plus grosse!!!!!!", MsgBoxStyle.Critical) : Exit Sub
984	–
985	–	swEnt = PlanDessus
986	–	swEnt.Select(False)
987	–	Directionnel = True
988	–
989	–	Flip = Flipper(PlanDessus, inter)
990	–
991	–	planReference = swModel.CreatePlaneAtOffset3(dist * 2, Flip, True)
992	–	Else
993	–	MsgBox("La coque n'est ni un cylindre, ni un plan" & vbCr & "Le résultat n'est pas certain...", MsgBoxStyle.Information, "Avertissement")
994	–	planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
995	–	Directionnel = False
996	–	Flip = False
997	–	End If
998	–
999	–
1000	–
1001	–	LaSurface = Me.SwFace.GetSurface()
1002	–	sens = Me.SwFace.FaceInSurfaceSense()
1003	–
1004	–	' 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.
1005	–	Dim i As Integer, MettreFI As Boolean
1006	–	Dim swFeat As SldWorks.Feature
1007	–
1008	–	For i = 0 To 1
1009	–
1010	–	swEnt = planReference
1011	–	swEnt.Select(False)
1012	–	swModel.InsertSketch2(False)
1013	–	swModel.ClearSelection2(True)
1014	–	swFeat = swModel.FeatureByPositionReverse(0)
1015	–	swModel.SelectByID(swFeat.Name, "SKETCH", 0, 0, 0)
1016	–	swModel.EditSketch()
1017	–	swsketch = swModel.GetActiveSketch2
1018	–
1019	–	p(0) = inter.x : p(1) = inter.y : p(2) = inter.z
1020	–	retour = Commun.TransfertModelSketch(swsketch, p)
1021	–
1022	–
1023	–	r = DessineSectionPoutre(poutre, retour(0), retour(1), i + 1, swsketch, inter, MettreFI)
1024	–	swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
1025	–	swModel.ClearSelection2(True)
1026	–
1027	–	Dim face As SldWorks.Face2
1028	–	For Each face In Me.lst_Faces
1029	–	swModel.ClearSelection2(True)
1030	–	swEnt = face : swEnt.Select2(False, 1)
1031	–	swEnt = swsketch : swEnt.Select2(True, 4)
1032	–	swModel.InsertSplitLineProject(Directionnel, Flip)
1033	–	Next
1034	–
1035	–
1036	–	Me.SwFace.DetachSurface()
1037	–	Me.SwFace.AttachSurface(LaSurface, sens)
1038	–
1039	–	Faces(i) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference, MettreFI)
1040	–	Commun.MettreUnPoint(r(0), r(1), r(2))
1041	–
1042	–	If Faces(i) Is Nothing Then
1043	–	swEnt.Select(False)
1044	–	swModel.EditDelete()
1045	–	End If
1046	–	If Flag = 2 Then Flag = 0 : Exit For
1047	–
1048	–	Next i
1049	–
1050	–	swModel.SetInferenceMode(True)
1051	–	'swModel.SetAddToDB(False)
1052	–	'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	<
1075	<	Dim lst_coupeXinter As New Collection
1076	<	Dim lst_coupeXPoutre As New Collection
1077	<	Dim lst_coupeLinter As New Collection
1078	<	Dim lst_coupeLPoutre As New Collection
1079	<	Dim lst_coupeCinter As New Collection
1080	<	Dim lst_coupeCPoutre As New Collection
1081	<
1082	<
1083	<	For Each inter In lst_InterPoutre
1084	<
1085	<	'pour chaque intersection on peut avoir plusieurs poutres...
1086	<	For i = 1 To inter.lst_sPoutre.Count
1087	<	poutreTest = inter.lst_sPoutre.Item(i)
1088	<	Select Case CInt(inter.lst_type.Item(i))
1089	<	Case 1
1090	<	If poutreTest.GetAireCarree > aire Then poutre1 = poutreTest
1091	<	nb1 += 1
1092	<	Case 2
1093	<	lst_poutre2.Add(poutreTest)
1094	<	nb2 += 1
1095	<	Case 3
1096	<	If poutreTest.GetAireCarree > aire Then poutre3 = poutreTest
1097	<	nb3 += 1
1098	<	Case 5 ' un poutre à faceDeSection
1099	<	nb5 += 1
1100	<	Case 22
1101	<	' on fait rien, mais c'est pour éviter le msgbox du case else...
1102	<	Case Else
1103	<	MsgBox("Problème dans découper de SlyFaceCoque, le type d'intersection n'est pas reconnu", MsgBoxStyle.Critical)
1104	<	End Select
1105	<	Next i
1106	<
1107	<
1108	<
1109	<	If nb1 > 0 Then 'CoupeX(inter, poutre1) ' on coupe le x en premier
1110	<	lst_coupeXinter.Add(inter)
1111	<	lst_coupeXPoutre.Add(poutre1)
1112	<	End If
1113	<
1114	<
1115	<	For Each poutreTest In lst_poutre2 ' puis on coupe sur la longueur 'CoupeLong(inter, poutreTest)
1116	<	lst_coupeLinter.Add(inter)
1117	<	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é...")
1127	<	End If
1128	<
1129	<
1130	<	lst_poutre2.Clear()
1131	<	nb1 = 0 : nb2 = 0 : nb3 = 0
1132	<
1133	<
1134	<	Next inter
1135	<
1136	<
1137	<	' maintenant on a toutes les lists d'intersections.  On les coupe.
1138	<	For i = 1 To lst_coupeXinter.Count
1139	<	CoupeX(lst_coupeXinter.Item(i), lst_coupeXPoutre.Item(i))
1140	<	Next
1141	<
1142	<	For i = 1 To lst_coupeLinter.Count
1143	<	CoupeLong(lst_coupeLinter.Item(i), lst_coupeLPoutre.Item(i))
1144	<	Next
1145	<
1146	<	For i = 1 To lst_coupeCinter.Count
1147	<	CoupeCote(lst_coupeCinter.Item(i), lst_coupeCPoutre.Item(i))
1148	<	Next
1149	<	If nb5 = 1 Then
1150	<	If lst_InterPoutre.Count <> 1 Then MsgBox("Plus d'une intersection du type FacedeSection....")
1151	<	CoupeFaceDeSection(lst_InterPoutre(1))
1152	<	End If
1153	<
1154	<	End Sub
1155	<
1156	<	Private Sub CoupeFaceDeSection(ByRef inter As InterPoutreVolume)
1157	<	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 1173 | 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)
1184	<	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
1185	<
1186	<	swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
1187	<	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
1214	<
1215	<
1216	<	'**************
1217	<	Me.AjouterFace(face)
1218	<	Next face
1219	<	Catch
1220	<	' si on a une poutre dessinée en partie, on aura pas de feature... mais on a la face...
1221	<	' on doit donc le déterminer anyway
1222	<	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
1229	–
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 1245 | 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 1253 | 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 1269 | 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 1523 | 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 1601 | 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 1625 | 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 1710 | 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 1727 | 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 1757 | 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 1766 | 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 1791 | Line 1332 | Public Class SuperFace
1332		End Select
1333		MettreFI = True
1334
1794	–	ElseIf Left(Poutre.GetNomSection, 1) = "P" Or Nomsection = " Circulaire pleine générique" Then ' Pipe,
1795	–	Dim P(2, 1) As Double
1796	–	Dim d As Double, e As Double
1797	–	d = Poutre.GetD1 / 4 ' Math.Sin(30)  ( et on doit diviser le diamètre par 2)
1798	–	e = Poutre.GetD1 * Math.Sqrt(3) / 4 ' cos (30°)
1799	–
1800	–	P(0, 0) = 0
1801	–	P(0, 1) = 0
1802	–	P(1, 0) = d
1803	–	P(1, 1) = -e
1804	–	P(2, 0) = d
1805	–	P(2, 1) = e
1806	–
1807	–	Select Case numero
1808	–	Case 1
1809	–	r(0) = P(0, 0) + 1000 * Epsilon
1810	–	r(1) = 0 : r(2) = 0
1811	–	Outils_Math.Rotation2D(pt3, r(0), r(1))
1812	–	r(0) += TranslationX
1813	–	r(1) += TranslationY
1814	–	r = Commun.TransfertSketchToModel(swSketch, r)
1815	–	pt3(0) -= TranslationX
1816	–	pt3(1) -= TranslationY
1817	–	pt3(0) /= longueur : pt3(1) /= longueur
1818	–	For i = 0 To 2
1819	–	Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1820	–	P(i, 0) += TranslationX
1821	–	P(i, 1) += TranslationY
1822	–	Next i
1823	–	ReDim Ligne(7)
1824	–	Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
1825	–	Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
1826	–	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
1827	–
1828	–	Case 2
1829	–	r(0) = P(0, 0) - 1000 * Epsilon
1830	–	r(1) = 0 : r(2) = 0
1831	–	Outils_Math.Rotation2D(pt3, r(0), r(1))
1832	–	r(0) += TranslationX
1833	–	r(1) += TranslationY
1834	–	r = Commun.TransfertSketchToModel(swSketch, r)
1835	–
1836	–	pt3(0) -= TranslationX
1837	–	pt3(1) -= TranslationY
1838	–	pt3(0) /= longueur : pt3(1) /= longueur
1839	–	For i = 0 To 2
1840	–	Outils_Math.Rotation2D(pt3, P(i, 0), P(i, 1))
1841	–	P(i, 0) += TranslationX
1842	–	P(i, 1) += TranslationY
1843	–	Next i
1844	–	ReDim Ligne(7)
1845	–	Ligne(0) = P(0, 0) : Ligne(1) = P(0, 1) : Ligne(2) = P(1, 0) : Ligne(3) = P(1, 1)
1846	–	Ligne(4) = P(0, 0) : Ligne(5) = P(0, 1) : Ligne(6) = P(2, 0) : Ligne(7) = P(2, 1)
1847	–
1848	–	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
1849	–
1850	–	End Select
1851	–	MettreFI = True
1335
1336		Else
1337		MsgBox("Section de poutre non reconnu!", MsgBoxStyle.Critical, "Commun.DessineSectionPoutre")
#	Line 1865 | 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 1882 | 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 1898 | 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 1915 | 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 1932 | 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 1945 | 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
1948	–
1431		swModel.SelectedFaceProperties(RGB(rouge, Vert, Bleu), Ambient, Diffuse, Specular, Shininess, Transparency, Emission, False, "")
1950	–
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 1998 | 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 2007 | 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 2038 | 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 2066 | 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 2074 | 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
2077	–
1566		vtemp = surf.EvaluateAtPoint(X, Y, Z)
1567		ReDim temp(2)
2080	–
1568		' la normale de la face pointe AWAY from the body
2082	–
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
2085	–
1571		If sens Then ' on doit inverser
1572		temp(0) = -vtemp(0) : temp(1) = -vtemp(1) : temp(2) = -vtemp(2)
1573		Else
#	Line 2092 | 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
2102	–	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