ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/InterCoqueCoque.vb
Revision: 46
Committed: Wed Aug 22 18:28:53 2007 UTC (17 years, 9 months ago) by bournival
File size: 9380 byte(s)
Log Message:
Ajout de la page de pré-optimisation automatique et des modification que j'ai apportées.

File Contents

# Content
1 Public Class InterCoqueCoque
2 Inherits InterFaceFace
3
4 Public sFaceCoque1 As SlyFaceCoque
5 Public sFaceCoque2 As SlyFaceCoque
6
7 Public AreteCoque1 As SldWorks.Edge
8 Public AreteCoque2 As SldWorks.Edge
9
10 ''' <summary>
11 ''' Sub qui dessine le sweep à l'endroit d'intersection
12 ''' </summary>
13 ''' <remarks>Je pourrais couper et mettre les faces internes ici, mais je préfère séparer...</remarks>
14 Public Function GénérerSweep(ByRef sketch As SldWorks.Sketch, ByVal rayon As Double) As SldWorks.Body2
15
16 Dim swEnt As SldWorks.Entity
17
18
19
20 ' technique du sweep du cercle
21 ' 1 - trace de la ligne d'intersection
22 ' en théorie c'est déjà fait et on a interFF.sketch qui a le sketch d'intersection...
23
24 ' 2- Placer un plan à l'extrémité
25 Dim Plan As SldWorks.RefPlane
26
27 Dim vSeg As Object 'SldWorks.SketchSegment
28 Dim seg As SldWorks.SketchSegment
29 Dim skPoint As SldWorks.SketchPoint = Nothing
30
31
32 vSeg = sketch.GetSketchSegments() : seg = vSeg(0)
33
34 Select Case seg.GetType ' faut faire attention, si le sketch est fermé, ça peut chier des taque pour séelectionner le point
35 Case SwConst.swSketchSegments_e.swSketchLINE
36 Dim skline As SldWorks.SketchLine = seg
37 skPoint = skline.GetStartPoint2()
38
39 Case SwConst.swSketchSegments_e.swSketchARC
40 Dim skarc As SldWorks.SketchArc = seg
41 skPoint = skarc.GetStartPoint2()
42 Case SwConst.swSketchSegments_e.swSketchELLIPSE
43 Dim skellipse As SldWorks.SketchEllipse = seg
44 skPoint = skellipse.GetStartPoint2()
45 If skPoint Is Nothing Then
46 ' couper l'ellipse
47 MsgBox("On a pas de startpoint sur cette ellipse")
48 End If
49 Case SwConst.swSketchSegments_e.swSketchSPLINE
50 Dim skSpline As SldWorks.SketchSpline = seg
51 Dim vPoints As Object
52 vPoints = skSpline.GetPoints2()
53 skPoint = vPoints(0)
54 Case SwConst.swSketchSegments_e.swSketchPARABOLA
55 Dim skPara As SldWorks.SketchParabola = seg
56 skPoint = skPara.GetStartPoint2()
57 Case Else
58 MsgBox(" Là y'a un problème! (case else....)")
59 End Select
60
61 seg.Select4(False, Nothing)
62 skPoint.Select4(True, Nothing)
63
64 Plan = swModel.CreatePlanePerCurveAndPassPoint3(True, False) ' le premier true met l'origine sur le point de la courbe, le second false est pour la visualisation.
65
66 ' 3 - on créé un cercle sur le plan
67 'Dim rayon As Double
68 'Dim sface As SlyFaceCoque = Me.sFaceCoque
69 Dim feat As SldWorks.Feature
70 Dim sketchCercle As SldWorks.Sketch
71
72 ' rayon = sface.GetEpaisseur
73 swEnt = Plan : swEnt.Select4(False, Nothing)
74
75 swModel.InsertSketch2(False)
76 swModel.CreateCircleByRadius2(0, 0, 0, rayon)
77 swModel.InsertSketch2(True)
78
79 feat = swModel.FeatureByPositionReverse(0)
80 sketchCercle = feat.GetSpecificFeature2()
81
82 ' 4 - Sweep
83 Dim swFeatManager As SldWorks.FeatureManager = swModel.FeatureManager
84
85 Dim merge As Boolean = False
86
87 swEnt = sketchCercle : swEnt.Select2(False, 1)
88 swEnt = sketch : swEnt.Select2(True, 4)
89
90 feat = swFeatManager.InsertProtrusionSwept3(False, False, 0, False, False, 1, 1, False, 0, 0, 0, 0, merge, 1, 1, 0, 1) ' merge fait additionner le bnouveau corps... Pas certain du false qui suit.
91
92 If feat Is Nothing Then
93 swEnt = sketchCercle : swEnt.Select2(False, 1)
94 swEnt = sketch : swEnt.Select2(True, 4)
95 feat = swFeatManager.InsertProtrusionSwept3(False, False, 0, False, False, 0, 0, False, 0, 0, 0, 0, 0, 1, 1, 0, 1)
96 End If
97
98 If feat Is Nothing Then
99 ' il est possible que la coque soit une spline
100 MsgBox("Il est impossible de découper la forme de la courbe, la coque est trop repliée sur elle-même..." & vbCr & "Un rayon de courbure de la section de la coque est inférieur à l'épaisseur de la coque", MsgBoxStyle.Information, "Impossible de découper à un endroit!")
101 ' on pourrait éventuellement appliquer une autre méthode.
102 Return Nothing
103 End If
104
105 Dim vfaces As Object = feat.GetFaces
106 Dim swface As SldWorks.Face2 = vfaces(0)
107 Me.BodySweep = swface.GetBody
108
109
110 If Me.BodySweep Is Nothing Then MsgBox(feat.Name)
111 Return Me.BodySweep
112
113 End Function
114
115 ''' <summary>
116 '''
117 ''' </summary>
118 ''' <param name="LaCoque"></param>
119 ''' <param name="sweep"></param>
120 ''' <remarks></remarks>
121 Public Sub DecouperCoque(ByRef LaCoque As SlyFaceCoque, ByRef sweep As SldWorks.Body2)
122 If Me.BodySweep Is Nothing Then Exit Sub
123
124
125 ' on a un sketch avec 2 ou plusieurs segments à l'intérieur
126 ' et si je sélectionnais un segment à la fois et partait un sketch3d, puis je convertis ce segment et construit ce nouveau sketch...
127 Dim vseg As Object = Me.sketch.GetSketchSegments
128 Dim PetitSketch As SldWorks.Sketch = Nothing
129 Dim swSketchManager As SldWorks.SketchManager = swModel.SketchManager
130 'Dim lstFeat As New Collections.Generic.List(Of SldWorks.Feature)
131 Dim swFace As SldWorks.Face2 = Me.BodySweep.GetFirstFace()
132 Dim swent As SldWorks.Entity
133 Dim featmanager As SldWorks.FeatureManager
134 Dim swface2 As SldWorks.Face2
135 Dim LautreCoque As SlyFaceCoque
136 LautreCoque = IIf(LaCoque Is Me.sFaceCoque1, Me.sFaceCoque2, Me.sFaceCoque1)
137
138
139 For Each segment As SldWorks.SketchSegment In vseg
140 swModel.ClearSelection()
141 If swModel.GetActiveSketch2() IsNot Nothing Then MsgBox("Déjà un sketch d'actif???")
142 swModel.Insert3DSketch2(False)
143 segment.Select4(False, Nothing)
144 swSketchManager.SketchUseEdge(False)
145 swModel.Insert3DSketch2(False)
146 swModel.EditRebuild3()
147
148 Dim feat As SldWorks.Feature = swModel.FeatureByPositionReverse(0)
149 If Not feat.GetTypeName() = "3DProfileFeature" Then MsgBox("Problème ici")
150 PetitSketch = feat.GetSpecificFeature2() ' devrait être un sketch
151
152
153 ' 2 - Couper la coque à partir su sweep
154 swModel.EditRebuild3()
155 featmanager = swModel.FeatureManager
156 Dim faces() As SldWorks.Face2 = LaCoque.GetFaces ' les faces de la coque qui sont découpées
157 For Each swface2 In faces ' les faces de la coque
158 If swModel.ClosestDistance(swface2, sweep, Nothing, Nothing) < Epsilon Then
159 swModel.ClearSelection2(True)
160 swFace = sweep.GetFirstFace()
161 Do While swFace IsNot Nothing ' les faces coupantes (celles du sweep) ont un mark de 16
162 swent = swFace : swent.Select2(True, 16)
163 swFace = swFace.GetNextFace
164 Loop
165 LautreCoque.SelectionnerToutes(16, True)
166
167 swent = swface2 : swent.Select2(True, 32) ' la face qui est coupée
168 feat = featmanager.InsertSplitLineIntersect(7)
169 'If feat IsNot Nothing Then lstFeat.Add(feat)
170 End If
171 Next
172 sweep.HideBody(True)
173
174 ' rajout des nouvelles faces à la coque
175 feat = swModel.FeatureByPositionReverse(0)
176 Dim vFaces As Object = feat.GetFaces()
177 For Each swFace In vFaces
178 LaCoque.AjouterFace(swFace)
179 Next
180
181 Next
182 End Sub
183
184
185 ''' <summary>
186 ''' Sub qui met les attributs de faces internes sur les bonnes faces.
187 ''' </summary>
188 ''' <remarks></remarks>
189 Public Sub MarquerFacesInternes(ByRef CoqueCoupante As SlyFaceCoque, ByRef CoqueCoupee As SlyFaceCoque)
190 ' bon, là il faut trouver les faces internes... mais: la liste de faces dans la slyface
191 'mais j'ai maintenant un moyen de comparer les arètes.
192 Dim trouve As Boolean = False
193 ' si une face de la liste des facesVol a une arête qui est comparer à true à une des arètes des faces de la coque, FACEINTERNE!!!
194 Dim swFaces() As SldWorks.Face2 = CoqueCoupee.GetFaces
195 Dim swAreteCoques() As SldWorks.Edge = CoqueCoupante.GetAretes
196
197 For Each face As SldWorks.Face2 In swFaces
198 Dim sFace As New SuperFace(face, True)
199 Dim swAreteVols() As SldWorks.Edge = sFace.GetAretes
200 For Each swAreteVol As SldWorks.Edge In swAreteVols
201 Dim e As New SuperArete(swAreteVol, True) : e.Colorer(2, 0, 1, 0)
202 For Each swAreteCoque As SldWorks.Edge In swAreteCoques
203 If e.comparer(swAreteCoque) Then
204 sFace.MettreAttributFaceInterne()
205 trouve = True : Exit For
206 End If
207 Next
208 If trouve Then trouve = False : Exit For ' on arete de gosser
209 Next
210 Next
211
212
213 End Sub
214
215
216 End Class