ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/InterCoqueCoque.vb
Revision: 48
Committed: Wed Aug 22 21:18:12 2007 UTC (17 years, 9 months ago) by bournival
File size: 9486 byte(s)
Log Message:
On passe aux nouveaux .dll

File Contents

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