Hallo
Ich habe ein Makro mit einem Teil, das das Fräsen auf einem MEP verbirgt, dieses Makro, das dank @JeromeP zu diesem Thema entwickelt wurde:https://www.lynkoa.com/forum/solidworks/macro-cacher-les-cercle-de-fraisure-assistance-de-per%C3%A7age
Mit der Ausnahme, dass dieses Makro 2 Löcher entfernt, die nicht gefräst sind und daher nicht erkannt werden sollten.
Ich hänge den Teil und den MEP an, der das Problem verursacht, sowie den verwendeten Code:
Option Explicit
Sub HideFraisage()
Dim swapp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim vComps As Variant
Dim vComp As Variant
Dim Comp As SldWorks.Component2
Dim vEdges As Variant
Dim vEdge As Variant
Dim swEdge As SldWorks.edge
Dim swCurve As SldWorks.Curve
Dim IsClosed As Boolean
Dim pos As String
Dim CurveParam As Variant
Dim Cercle As Class1
Dim monCercle As Class1
Dim Cercles As Collection
Dim Resultat As Variant
Dim m As Double
Set swapp = Application.SldWorks
Set swModel = swapp.ActiveDoc
Set swDraw = swModel
Set swView = swDraw.GetFirstView.GetNextView
'Set swView = swDraw.ActiveDrawingView
'If swView Is Nothing Then
'MsgBox "Selectionner une vue"
'Exit Sub
'End If
'Ajout SD pour récuperer les valeures de la Bounding Box (Longueur Largeur épaisseur)
Dim swPartModel As SldWorks.ModelDoc2
Set swPartModel = swView.ReferencedDocument
Resultat = GetPreciseBoundingBox(swPartModel)
' Fin de l'ajout
'On r
Set Cercles = New Collection
vComps = swView.GetVisibleComponents
For Each vComp In vComps
Set Comp = vComp
vEdges = swView.GetVisibleEntities(Comp, swViewEntityType_e.swViewEntityType_Edge)
For Each vEdge In vEdges
Set swEdge = vEdge
Set swCurve = swEdge.GetCurve
If swCurve.IsCircle Then
swCurve.GetEndParams Empty, Empty, IsClosed, Empty
If IsClosed Then
CurveParam = swCurve.CircleParams
pos = ""
If Round(CurveParam(3), 5) = 0 Then pos = pos & Round(CurveParam(0), 5) & "-"
If Round(CurveParam(4), 5) = 0 Then pos = pos & Round(CurveParam(1), 5) & "-"
If Round(CurveParam(5), 5) = 0 Then pos = pos & Round(CurveParam(2), 5) & "-"
'Debug.Print pos
Set Cercle = New Class1
Cercle.pos = pos
Cercle.dia = (Round(CurveParam(6), 10)) * 1000
Set Cercle.edge = swEdge
Cercles.Add Cercle
End If
End If
Next
Next
swModel.ClearSelection2 True
For Each monCercle In Cercles
For Each Cercle In Cercles
If Cercle.pos = monCercle.pos And Cercle.dia < monCercle.dia And (monCercle.dia * 2) < (Resultat(1) - 2) Then
monCercle.edge.Select4 True, Nothing
End If
Next
Next
'On cache le cercle
swDraw.HideEdge
swModel.ForceRebuild3 False
swModel.ClearSelection2 True
End Sub
Function GetPreciseBoundingBox(part As SldWorks.PartDoc) As Variant
Dim dBox(2) As Double
Dim vBodies As Variant
vBodies = part.GetBodies2(swBodyType_e.swSolidBody, True)
Dim minX As Double
Dim minY As Double
Dim minZ As Double
Dim maxX As Double
Dim maxY As Double
Dim maxZ As Double
Dim First As Integer, Last As Long
Dim j, k As Long
Dim temp As Double
If Not IsEmpty(vBodies) Then
Dim i As Integer
For i = 0 To UBound(vBodies)
Dim swBody As SldWorks.Body2
Set swBody = vBodies(i)
Dim x As Double
Dim y As Double
Dim z As Double
swBody.GetExtremePoint 1, 0, 0, x, y, z
If i = 0 Or x > maxX Then maxX = x
swBody.GetExtremePoint -1, 0, 0, x, y, z
If i = 0 Or x < minX Then minX = x
swBody.GetExtremePoint 0, 1, 0, x, y, z
If i = 0 Or y > maxY Then maxY = y
swBody.GetExtremePoint 0, -1, 0, x, y, z
If i = 0 Or y < minY Then minY = y
swBody.GetExtremePoint 0, 0, 1, x, y, z
If i = 0 Or z > maxZ Then maxZ = z
swBody.GetExtremePoint 0, 0, -1, x, y, z
If i = 0 Or z < minZ Then minZ = z
Next
End If
x = (maxX - minX) * 1000
y = (maxY - minY) * 1000
z = (maxZ - minZ) * 1000
'Debug.Print "x=" & x
'Debug.Print "y=" & y
'Debug.Print "z=" & z
dBox(0) = x: dBox(1) = y: dBox(2) = z
First = LBound(dBox)
Last = UBound(dBox)
For j = First To Last - 1
For k = j + 1 To Last
If dBox(j) > dBox(k) Then
temp = dBox(k)
dBox(k) = dBox(j)
dBox(j) = temp
End If
Next k
Next j
'Debug.Print "Longueur:" & dBox(2)
'Debug.Print "Largeur:" & dBox(1)
'Debug.Print "Epaisseur:" & dBox(0)
GetPreciseBoundingBox = dBox
End Function
Ich dachte zunächst, dass die symmetrische Position der 2 Kreise bedeutet, dass es das - auf einer der 2 Positionen nicht erkennt und dass es daher glaubt, dass die 2 Kreise überlagert sind, also habe ich 2 weitere Kreise symmetrisch am Ursprung des Teils hinzugefügt und diese werden so behandelt, wie sie sollten (ignoriert)
Ich verstehe also nicht wirklich, ob jemand eine Idee zu dem Thema hat.
pb_trou_2.zip