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

# User Rev Content
1 bournival 40 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 bournival 46 ''' <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 bournival 40
16 bournival 46 Dim swEnt As SldWorks.Entity
17 bournival 40
18    
19    
20 bournival 46 ' 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 bournival 40
24 bournival 46 ' 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 bournival 40 End Class