ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/InterPoutreCoque.vb
Revision: 205
Committed: Thu Jul 23 20:53:57 2009 UTC (15 years, 9 months ago) by bournival
File size: 4668 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

# User Rev Content
1 bournival 205 Imports SolidWorks.Interop
2     Imports SolidWorks.Interop.swconst
3     Imports SolidWorks.Interop.swpublished
4    
5 bournival 40 Public Class InterPoutreCoque
6     Inherits InterAreteFace
7    
8     Public sFaceCoque As SlyFaceCoque
9    
10    
11 bournival 205 Public Overrides Sub DecouperLong()
12     MyBase.DecouperLong()
13     ' on peut avoir une liste de poutres...
14     'For Each poutre As SlyAretePoutre In Me.lst_sPoutre
15     Dim poutre As SlyAretePoutre = Me.lst_sPoutre.Item(1)
16 bournival 40
17 bournival 205 Dim PetitSketch As sldworks.Sketch = Nothing
18     Dim swSketchManager As sldworks.SketchManager = swModel.SketchManager
19     Dim sfaceCoq As SlyFaceCoque ' la face du volume
20     Dim swfaceCoq As sldworks.Face2
21 bournival 40
22 bournival 205 Dim segment As sldworks.Entity = poutre.swArete
23    
24     swModel.ClearSelection()
25     If swModel.GetActiveSketch2() IsNot Nothing Then MsgBox("Déjà un sketch d'actif???")
26     swModel.Insert3DSketch2(False)
27     segment.Select4(False, Nothing)
28     swSketchManager.SketchUseEdge(False)
29     swModel.Insert3DSketch2(False)
30     swModel.EditRebuild3()
31    
32     Dim feat As sldworks.Feature = swModel.FeatureByPositionReverse(0)
33     If Not feat.GetTypeName() = "3DProfileFeature" Then MsgBox("Problème ici")
34     PetitSketch = feat.GetSpecificFeature2() ' devrait être un sketch
35    
36     ' 1 - créer le sweep à partir du sketch
37     Me.GénérerSweep(PetitSketch) ' hahahaha on réutilise la sub !!
38    
39     ' sélectionner toutes les faces du sweep avec un mark de 16
40     Dim swFaceSweep As sldworks.Face2 = Me.BodySweep.GetFirstFace()
41     Dim swent As sldworks.Entity
42     Dim featmanager As sldworks.FeatureManager
43     Dim faces() As sldworks.Face2
44    
45    
46     ' ***** Découpage du volume****
47     swModel.EditRebuild3()
48     featmanager = swModel.FeatureManager
49     feat = Nothing
50    
51    
52     sfaceCoq = Me.sFaceCoque
53    
54    
55     faces = sfaceCoq.GetFaces
56    
57    
58     For q As Integer = 0 To UBound(faces)
59     swfaceCoq = faces(q)
60     ' 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.
61     If swModel.ClosestDistance(swfaceCoq, Me.BodySweep, Nothing, Nothing) < Epsilon Then
62    
63     swModel.ClearSelection2(True)
64     Do While swFaceSweep IsNot Nothing ' les faces coupantes (celles du sweep) ont un mark de 16
65     swent = swFaceSweep : swent.Select2(True, 16)
66     swFaceSweep = swFaceSweep.GetNextFace
67     Loop
68    
69     swent = swfaceCoq : swent.Select2(True, 32)
70     feat = featmanager.InsertSplitLineIntersect(7)
71     If feat IsNot Nothing Then Exit For
72    
73     End If
74     Next
75    
76     If feat Is Nothing Then
77     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
78     End If
79    
80     Me.BodySweep.HideBody(True)
81    
82     ' ajout des nouvelles faces
83     Dim vfaces As Object = feat.GetFaces()
84     swModel.EditRebuild3()
85    
86     For Each swfaceCoq In vfaces ' sélectionne les faces découpées.
87     If Not swfaceCoq.GetBody Is Me.BodySweep Then
88     sfaceCoq.AjouterFace(swfaceCoq)
89     'là on a une connerie, la face originale n'est pas dans la liste des faces de vFaces
90     'et le pointeur original semble détruit
91     ' puisque ajouterface ne créé pas de doubles, on va chercher des faces que l'on mettra dans la liste
92     ' la grosse face en fera automatiquement partie.
93     Dim obj As Object = swfaceCoq.GetEdges
94     Dim aretes As sldworks.Edge = obj(0)
95     Dim oBjfaces As Object = aretes.GetTwoAdjacentFaces2()
96     Dim NewFaces As sldworks.Face2 = oBjfaces(0)
97     sfaceCoq.AjouterFace(NewFaces)
98     NewFaces = oBjfaces(1)
99     sfaceCoq.AjouterFace(NewFaces)
100     aretes = obj(1)
101     NewFaces = oBjfaces(0)
102     sfaceCoq.AjouterFace(NewFaces)
103     NewFaces = oBjfaces(1)
104     sfaceCoq.AjouterFace(NewFaces)
105     End If
106     Next
107    
108     ' il faut trouver les faces internes et les tagger comme des faces de coque(pour les mini-poutres orientées)
109    
110     'Next poutre
111     End Sub
112    
113    
114 bournival 40 End Class