[ViewVC] Diff of: REPOS_ERICCA/magicsld/InterAreteFace.vb

Comparing magicsld/InterAreteFace.vb (file contents):
Revision 129 by bournival, Mon Aug 20 21:30:28 2007 UTC vs.
Revision 130 by bournival, Wed Jul 30 21:26:03 2008 UTC

-+
+Imports SolidWorks.Interop
-+
+Imports SolidWorks.Interop.swconst
-+
+Imports SolidWorks.Interop.swpublished
-+
+Public MustInherit Class InterAreteFace
+    Inherits SuperIntersection
+    Public x As Double ' la coordonnée x de l'intersection
+    Public y As Double
+    Public z As Double
-+
-+
+    Public sFaceVolume As SlyFaceVolume
-+
+    Private BodySweep As sldworks.Body2
-+
-+
-+
+    Public Sub DecouperLong()
-+
+        ' on peut avoir une liste de poutres...
-+
+        'For Each poutre As SlyAretePoutre In Me.lst_sPoutre
-+
+        Dim poutre As SlyAretePoutre = Me.lst_sPoutre.Item(1)
-+
-+
+        Dim PetitSketch As sldworks.Sketch = Nothing
-+
+        Dim swSketchManager As sldworks.SketchManager = swModel.SketchManager
-+
+        Dim sfaceVol As SlyFaceVolume   ' la face du volume
-+
+        Dim swfaceVol As sldworks.Face2
-+
-+
+        Dim segment As sldworks.Entity = poutre.swArete
-+
-+
+        swModel.ClearSelection()
-+
+        If swModel.GetActiveSketch2() IsNot Nothing Then MsgBox("Déjà un sketch d'actif???")
-+
+        swModel.Insert3DSketch2(False)
-+
+        segment.Select4(False, Nothing)
-+
+        swSketchManager.SketchUseEdge(False)
-+
+        swModel.Insert3DSketch2(False)
-+
+        swModel.EditRebuild3()
-+
-+
+        Dim feat As sldworks.Feature = swModel.FeatureByPositionReverse(0)
-+
+        If Not feat.GetTypeName() = "3DProfileFeature" Then MsgBox("Problème ici")
-+
+        PetitSketch = feat.GetSpecificFeature2() ' devrait être un sketch
-+
-+
+        ' 1 - créer le sweep à partir du sketch
-+
+        Me.GénérerSweep(PetitSketch) ' hahahaha on réutilise la sub !!
-+
-+
+        ' sélectionner toutes les faces du sweep avec un mark de 16
-+
+        Dim swFaceSweep As sldworks.Face2 = Me.BodySweep.GetFirstFace()
-+
+        Dim swent As sldworks.Entity
-+
+        Dim featmanager As sldworks.FeatureManager
-+
+        Dim faces() As sldworks.Face2
-+
-+
-+
+        '  ***** Découpage du volume****
-+
+        swModel.EditRebuild3()
-+
+        featmanager = swModel.FeatureManager
-+
+        feat = Nothing
-+
+        sfaceVol = Me.sFaceVolume
-+
+        faces = sfaceVol.GetFaces
-+
-+
-+
+        For q As Integer = 0 To UBound(faces)
-+
+            swfaceVol = faces(q)
-+
+            ' 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.
-+
+            If swModel.ClosestDistance(swfaceVol, Me.BodySweep, Nothing, Nothing) < Epsilon Then
-+
-+
+                swModel.ClearSelection2(True)
-+
+                Do While swFaceSweep IsNot Nothing  ' les faces coupantes (celles du sweep) ont un mark de 16
-+
+                    swent = swFaceSweep : swent.Select2(True, 16)
-+
+                    swFaceSweep = swFaceSweep.GetNextFace
-+
+                Loop
-+
-+
+                swent = swfaceVol : swent.Select2(True, 32)
-+
+                feat = featmanager.InsertSplitLineIntersect(7)
-+
+                If feat IsNot Nothing Then Exit For
-+
-+
+            End If
-+
+        Next
-+
-+
+        If feat Is Nothing Then
-+
+            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
-+
+        End If
-+
-+
+        Me.BodySweep.HideBody(True)
-+
-+
+        ' ajout des nouvelles faces
-+
+        Dim vfaces As Object = feat.GetFaces()
-+
+        swModel.EditRebuild3()
-+
-+
+        For Each swfaceVol In vfaces  ' sélectionne les faces découpées.
-+
+            If Not swfaceVol.GetBody Is Me.BodySweep Then
-+
+                sfaceVol.AjouterFace(swfaceVol)
-+
+                'là on a une connerie, la face originale n'est pas dans la liste des faces de vFaces
-+
+                'et le pointeur original semble détruit
-+
+                ' puisque ajouterface ne créé pas de doubles, on va chercher des faces que l'on mettra dans la liste
-+
+                ' la grosse face en fera automatiquement partie.
-+
+                Dim obj As Object = swfaceVol.GetEdges
-+
+                Dim aretes As sldworks.Edge = obj(0)
-+
+                Dim oBjfaces As Object = aretes.GetTwoAdjacentFaces2()
-+
+                Dim NewFaces As sldworks.Face2 = oBjfaces(0)
-+
+                sfaceVol.AjouterFace(NewFaces)
-+
+                NewFaces = oBjfaces(1)
-+
+                sfaceVol.AjouterFace(NewFaces)
-+
+                aretes = obj(1)
-+
+                NewFaces = oBjfaces(0)
-+
+                sfaceVol.AjouterFace(NewFaces)
-+
+                NewFaces = oBjfaces(1)
-+
+                sfaceVol.AjouterFace(NewFaces)
-+
+            End If
-+
+        Next
-+
-+
+        ' il faut trouver les faces internes et les tagger comme des faces de coque(pour les mini-poutres orientées)
-+
-+
+        'Next poutre
-+
+    End Sub
-+
-+
+    Public Sub GénérerSweep(Optional ByRef sketch As sldworks.Sketch = Nothing)
-+
+        ' on peut essayer 2 méthodes, celle du offset des faces et celle du sweep d'un cercle
-+
+        ' celle du offset ne marche pas dans toutes les circonstances...
-+
+        Dim swEnt As SldWorks.Entity
-+
-+
-+
+        ' 2- Placer un plan à l'extrémité
-+
+        Dim Plan As SldWorks.RefPlane
-+
-+
+        Dim vSeg As Object 'SldWorks.SketchSegment
-+
+        Dim seg As SldWorks.SketchSegment
-+
+        Dim skPoint As SldWorks.SketchPoint = Nothing
-+
-+
-+
+        vSeg = sketch.GetSketchSegments() : seg = vSeg(0)
-+
-+
+        Select Case seg.GetType ' faut faire attention, si le sketch est fermé, ça peut chier des taque pour séelectionner le point
-+
+            Case SwConst.swSketchSegments_e.swSketchLINE
-+
+                Dim skline As SldWorks.SketchLine = seg
-+
+                skPoint = skline.GetStartPoint2()
-+
-+
+            Case SwConst.swSketchSegments_e.swSketchARC
-+
+                Dim skarc As SldWorks.SketchArc = seg
-+
+                skPoint = skarc.GetStartPoint2()
-+
+            Case SwConst.swSketchSegments_e.swSketchELLIPSE
-+
+                Dim skellipse As SldWorks.SketchEllipse = seg
-+
+                skPoint = skellipse.GetStartPoint2()
-+
+                If skPoint Is Nothing Then
-+
+                    ' couper l'ellipse
-+
+                    MsgBox("On a pas de startpoint sur cette ellipse")
-+
+                End If
-+
+            Case SwConst.swSketchSegments_e.swSketchSPLINE
-+
+                Dim skSpline As SldWorks.SketchSpline = seg
-+
+                Dim vPoints As Object
-+
+                vPoints = skSpline.GetPoints2()
-+
+                skPoint = vPoints(0)
-+
+            Case SwConst.swSketchSegments_e.swSketchPARABOLA
-+
+                Dim skPara As SldWorks.SketchParabola = seg
-+
+                skPoint = skPara.GetStartPoint2()
-+
+            Case Else
-+
+                MsgBox(" Là y'a un problème! (case else....)")
-+
+        End Select
-+
-+
+        seg.Select4(False, Nothing)
-+
+        skPoint.Select4(True, Nothing)
-+
-+
+        Plan = swModel.CreatePlanePerCurveAndPassPoint3(True, False) ' le premier true met l'origine sur le point de la courbe, le second false est pour la visualisation.
-+
-+
+        ' 3 - on créé un cercle sur le plan
-+
+        Dim rayon As Double
-+
+        Dim sface As SlyFaceVolume = Me.sFaceVolume
-+
+        Dim feat As SldWorks.Feature
-+
+        Dim sketchCercle As SldWorks.Sketch
-+
+        Dim poutre As SlyAretePoutre
-+
-+
+        rayon = Commun.ENG * Math.Sqrt(3) / 2 ' la bonne distance pour le maillage  :-)
-+
+        swEnt = Plan : swEnt.Select4(False, Nothing)
-+
-+
+        swModel.InsertSketch2(False)
-+
+        swModel.CreateCircle2(rayon / 2, 0, 0, 0, 0, 0)
-+
+        swModel.InsertSketch2(True)
-+
-+
+        feat = swModel.FeatureByPositionReverse(0)
-+
+        sketchCercle = feat.GetSpecificFeature2()
-+
-+
+        ' 4 - Sweep
-+
+        Dim swFeatManager As SldWorks.FeatureManager = swModel.FeatureManager
-+
-+
+        Dim merge As Boolean = False
-+
-+
+        swEnt = sketchCercle : swEnt.Select2(False, 1)
-+
+        swEnt = sketch : swEnt.Select2(True, 4)
-+
-+
+        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.
-+
-+
+        If feat Is Nothing Then
-+
+            swEnt = sketchCercle : swEnt.Select2(False, 1)
-+
+            swEnt = sketch : swEnt.Select2(True, 4)
-+
+            feat = swFeatManager.InsertProtrusionSwept3(False, False, 0, False, False, 0, 0, False, 0, 0, 0, 0, 0, 1, 1, 0, 1)
-+
+        End If
-+
-+
+        If feat Is Nothing Then
-+
+            ' il est possible que la coque soit une spline
-+
+            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!")
-+
+            ' on pourrait éventuellement appliquer une autre méthode.
-+
+            Exit Sub
-+
+        End If
-+
-+
+        Dim vfaces As Object = feat.GetFaces
-+
+        Dim swface As SldWorks.Face2 = vfaces(0)
-+
+        Me.BodySweep = swface.GetBody
-+
-+
-+
+        If Me.BodySweep Is Nothing Then MsgBox(feat.Name)
-+
-+
+    End Sub
-+
+End Class

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing magicsld/InterAreteFace.vb (file contents): Revision 129 by bournival, Mon Aug 20 21:30:28 2007 UTC vs. Revision 130 by bournival, Wed Jul 30 21:26:03 2008 UTC

Diff Legend

Comparing magicsld/InterAreteFace.vb (file contents):
Revision 129 by bournival, Mon Aug 20 21:30:28 2007 UTC vs.
Revision 130 by bournival, Wed Jul 30 21:26:03 2008 UTC