ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/InterAreteFace.vb
Revision: 205
Committed: Thu Jul 23 20:53:57 2009 UTC (15 years, 9 months ago) by bournival
File size: 10155 byte(s)
Log Message:
Commit de MAGiC_SLD pendant que j'y pense.  Les modifications ne devraient pas concerner personne d'autre que moi.   -- Sylvain

File Contents

# Content
1 Imports SolidWorks.Interop
2 Imports SolidWorks.Interop.swconst
3 Imports SolidWorks.Interop.swpublished
4
5 Public MustInherit Class InterAreteFace
6 Inherits SuperIntersection
7
8
9 Public lst_sPoutre As New Collection 'SlyAretePoutre ' une collection car on peut avoir plus d'une poutre au même point.
10 Public lst_type As New Collection ' type: à chaque poutre de la liste d'avant, il y a un type d'intersection. 1- coupe en X 2- sur face, intérieure 3 - sur face, extérieure
11
12
13 Public x As Double ' la coordonnée x de l'intersection
14 Public y As Double
15 Public z As Double
16
17 Public sFaceVolume As SlyFaceVolume
18 Friend BodySweep As sldworks.Body2
19
20
21 Public Overridable Sub DecouperLong()
22 ' dans les classes dérivées.
23
24
25 'MyBase.DecouperLong()
26 '' on peut avoir une liste de poutres...
27 ''For Each poutre As SlyAretePoutre In Me.lst_sPoutre
28 'Dim poutre As SlyAretePoutre = Me.lst_sPoutre.Item(1)
29
30 'Dim PetitSketch As sldworks.Sketch = Nothing
31 'Dim swSketchManager As sldworks.SketchManager = swModel.SketchManager
32 'Dim sfaceVol As SlyFaceVolume ' la face du volume
33 'Dim swfaceVol As sldworks.Face2
34
35 'Dim segment As sldworks.Entity = poutre.swArete
36
37 'swModel.ClearSelection()
38 'If swModel.GetActiveSketch2() IsNot Nothing Then MsgBox("Déjà un sketch d'actif???")
39 'swModel.Insert3DSketch2(False)
40 'segment.Select4(False, Nothing)
41 'swSketchManager.SketchUseEdge(False)
42 'swModel.Insert3DSketch2(False)
43 'swModel.EditRebuild3()
44
45 'Dim feat As sldworks.Feature = swModel.FeatureByPositionReverse(0)
46 'If Not feat.GetTypeName() = "3DProfileFeature" Then MsgBox("Problème ici")
47 'PetitSketch = feat.GetSpecificFeature2() ' devrait être un sketch
48
49 '' 1 - créer le sweep à partir du sketch
50 'Me.GénérerSweep(PetitSketch) ' hahahaha on réutilise la sub !!
51
52 '' sélectionner toutes les faces du sweep avec un mark de 16
53 'Dim swFaceSweep As sldworks.Face2 = Me.BodySweep.GetFirstFace()
54 'Dim swent As sldworks.Entity
55 'Dim featmanager As sldworks.FeatureManager
56 'Dim faces() As sldworks.Face2
57
58
59 '' ***** Découpage du volume****
60 'swModel.EditRebuild3()
61 'featmanager = swModel.FeatureManager
62 'feat = Nothing
63
64
65 'sfaceVol = Me.sFaceVolume
66
67
68 'faces = sfaceVol.GetFaces
69
70
71 'For q As Integer = 0 To UBound(faces)
72 ' swfaceVol = faces(q)
73 ' ' merde, on a 3 fois la même face??? vérifier que le for each marche bien et/ou que le .ToArray du faces est corect.
74 ' If swModel.ClosestDistance(swfaceVol, Me.BodySweep, Nothing, Nothing) < Epsilon Then
75
76 ' swModel.ClearSelection2(True)
77 ' Do While swFaceSweep IsNot Nothing ' les faces coupantes (celles du sweep) ont un mark de 16
78 ' swent = swFaceSweep : swent.Select2(True, 16)
79 ' swFaceSweep = swFaceSweep.GetNextFace
80 ' Loop
81
82 ' swent = swfaceVol : swent.Select2(True, 32)
83 ' feat = featmanager.InsertSplitLineIntersect(7)
84 ' If feat IsNot Nothing Then Exit For
85
86 ' End If
87 'Next
88
89 'If feat Is Nothing Then
90 ' If swApp.SendMsgToUser2("Solidworks est incapable de découper la face du volume, entre " & Me.sFaceVolume.nom & " et " & Me.sFaceVolume.nom & vbCr & " La géométrie est trop compliquée pour solidworks!", swconst.swMessageBoxIcon_e.swMbWarning, swconst.swMessageBoxBtn_e.swMbRetryCancel) = swconst.swMessageBoxResult_e.swMbHitCancel Then Exit Sub
91 'End If
92
93 'Me.BodySweep.HideBody(True)
94
95 '' ajout des nouvelles faces
96 'Dim vfaces As Object = feat.GetFaces()
97 'swModel.EditRebuild3()
98
99 'For Each swfaceVol In vfaces ' sélectionne les faces découpées.
100 ' If Not swfaceVol.GetBody Is Me.BodySweep Then
101 ' sfaceVol.AjouterFace(swfaceVol)
102 ' 'là on a une connerie, la face originale n'est pas dans la liste des faces de vFaces
103 ' 'et le pointeur original semble détruit
104 ' ' puisque ajouterface ne créé pas de doubles, on va chercher des faces que l'on mettra dans la liste
105 ' ' la grosse face en fera automatiquement partie.
106 ' Dim obj As Object = swfaceVol.GetEdges
107 ' Dim aretes As sldworks.Edge = obj(0)
108 ' Dim oBjfaces As Object = aretes.GetTwoAdjacentFaces2()
109 ' Dim NewFaces As sldworks.Face2 = oBjfaces(0)
110 ' sfaceVol.AjouterFace(NewFaces)
111 ' NewFaces = oBjfaces(1)
112 ' sfaceVol.AjouterFace(NewFaces)
113 ' aretes = obj(1)
114 ' NewFaces = oBjfaces(0)
115 ' sfaceVol.AjouterFace(NewFaces)
116 ' NewFaces = oBjfaces(1)
117 ' sfaceVol.AjouterFace(NewFaces)
118 ' End If
119 'Next
120
121 '' il faut trouver les faces internes et les tagger comme des faces de coque(pour les mini-poutres orientées)
122
123 ''Next poutre
124 End Sub
125
126 Public Sub GénérerSweep(Optional ByRef sketch As sldworks.Sketch = Nothing)
127 ' on peut essayer 2 méthodes, celle du offset des faces et celle du sweep d'un cercle
128 ' celle du offset ne marche pas dans toutes les circonstances...
129 Dim swEnt As SldWorks.Entity
130
131
132 ' 2- Placer un plan à l'extrémité
133 Dim Plan As SldWorks.RefPlane
134
135 Dim vSeg As Object 'SldWorks.SketchSegment
136 Dim seg As SldWorks.SketchSegment
137 Dim skPoint As SldWorks.SketchPoint = Nothing
138
139
140 vSeg = sketch.GetSketchSegments() : seg = vSeg(0)
141
142 Select Case seg.GetType ' faut faire attention, si le sketch est fermé, ça peut chier des taque pour séelectionner le point
143 Case SwConst.swSketchSegments_e.swSketchLINE
144 Dim skline As SldWorks.SketchLine = seg
145 skPoint = skline.GetStartPoint2()
146
147 Case SwConst.swSketchSegments_e.swSketchARC
148 Dim skarc As SldWorks.SketchArc = seg
149 skPoint = skarc.GetStartPoint2()
150 Case SwConst.swSketchSegments_e.swSketchELLIPSE
151 Dim skellipse As SldWorks.SketchEllipse = seg
152 skPoint = skellipse.GetStartPoint2()
153 If skPoint Is Nothing Then
154 ' couper l'ellipse
155 MsgBox("On a pas de startpoint sur cette ellipse")
156 End If
157 Case SwConst.swSketchSegments_e.swSketchSPLINE
158 Dim skSpline As SldWorks.SketchSpline = seg
159 Dim vPoints As Object
160 vPoints = skSpline.GetPoints2()
161 skPoint = vPoints(0)
162 Case SwConst.swSketchSegments_e.swSketchPARABOLA
163 Dim skPara As SldWorks.SketchParabola = seg
164 skPoint = skPara.GetStartPoint2()
165 Case Else
166 MsgBox(" Là y'a un problème! (case else....)")
167 End Select
168
169 seg.Select4(False, Nothing)
170 skPoint.Select4(True, Nothing)
171
172 Plan = swModel.CreatePlanePerCurveAndPassPoint3(True, False) ' le premier true met l'origine sur le point de la courbe, le second false est pour la visualisation.
173
174 ' 3 - on créé un cercle sur le plan
175 Dim rayon As Double
176 Dim sface As SlyFaceVolume = Me.sFaceVolume
177 Dim feat As SldWorks.Feature
178 Dim sketchCercle As SldWorks.Sketch
179 Dim poutre As SlyAretePoutre
180
181 rayon = Commun.ENG * Math.Sqrt(3) / 2 ' la bonne distance pour le maillage :-)
182 swEnt = Plan : swEnt.Select4(False, Nothing)
183
184 swModel.InsertSketch2(False)
185 ' faut faire attention où on place le point...
186 Dim NormaleFace() As Double = Me.sFaceVolume.GetNormaleSurface(Me.x, Me.y, Me.z)
187 Dim P(2) As Double : P(1) = 1
188 Dim VecteurX() As Double = Commun.TransfertSketchToModel(swModel.GetActiveSketch2(), P)
189 If (Outils_Math.Angle2Vecteurs(NormaleFace, VecteurX) < (1000 * Epsilon)) Or (Math.Abs(Outils_Math.Angle2Vecteurs(NormaleFace, VecteurX) - Math.PI / 2) < (1000 * Epsilon)) Then
190 swModel.CreateCircle2(0, rayon / 2, 0, 0, 0, 0)
191 Else
192 swModel.CreateCircle2(rayon / 2, 0, 0, 0, 0, 0)
193 End If
194
195
196 swModel.InsertSketch2(True)
197
198 feat = swModel.FeatureByPositionReverse(0)
199 sketchCercle = feat.GetSpecificFeature2()
200
201 ' 4 - Sweep
202 Dim swFeatManager As sldworks.FeatureManager = swModel.FeatureManager
203
204 Dim merge As Boolean = False
205
206 swEnt = sketchCercle : swEnt.Select2(False, 1)
207 swEnt = sketch : swEnt.Select2(True, 4)
208
209 feat = swFeatManager.InsertProtrusionSwept3(False, False, 0, False, False, swTangencyType_e.swTangencyNone, swTangencyType_e.swTangencyNone, False, 0, 0, 0, 0, 0, 1, 1, 0, 1)
210
211 If feat Is Nothing Then
212 swEnt = sketchCercle : swEnt.Select2(False, 1)
213 swEnt = sketch : swEnt.Select2(True, 4)
214 feat = swFeatManager.InsertProtrusionSwept3(False, False, 0, False, False, swTangencyType_e.swTangencyNone, swTangencyType_e.swTangencyNone, False, 0, 0, 0, 0, 0, 1, 1, 0, 1)
215 End If
216
217 If feat Is Nothing Then
218 ' il est possible que la coque soit une spline
219 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!")
220 ' on pourrait éventuellement appliquer une autre méthode.
221 Exit Sub
222 End If
223
224 Dim vfaces As Object = feat.GetFaces
225 Dim swface As sldworks.Face2 = vfaces(0)
226 Me.BodySweep = swface.GetBody
227
228
229 If Me.BodySweep Is Nothing Then MsgBox(feat.Name)
230
231 End Sub
232
233 End Class