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
|