Delete Blended Faces Example (VBA)
This example shows how to delete blended faces.
NOTE: You
can only delete blended faces from a temporary body.
'----------------------------------------
' Preconditions:
' (1)
Part is open.
' (2)
Part only contains one solid body.
' (3)
At least one blended (filleted) face on the part is selected.
'
' Postconditions:
' (1)
New part is created.
' (2)
New part has same body as original part
' but
with the selected blended faces removed.
'
' NOTE: It
might not be possible to remove the
' selected
blended faces. If they're not removed, then
' the
new body will be the same as the original
' body.
'
'----------------------------------------
Option Explicit
Function GetFacesWithAttribute _
( _
swApp
As SldWorks.SldWorks, _
swBody
As SldWorks.body2, _
swAttDef
As SldWorks.attributeDef _
) As Variant
Dim
swFace As
SldWorks.face2
Dim
swEnt As
SldWorks.entity
Dim
swAttCopy As
SldWorks.Attribute
Dim
swFaceArr() As
SldWorks.face2
'
Search for faces on temporary body based on copied attributes
ReDim
swFaceArr(0)
Set
swFace = swBody.GetFirstFace
Do
While Not Nothing Is swFace
Set
swEnt = swFace
Set
swAttCopy = Nothing
'
Only one instance of attribute should exist
Set
swAttCopy = swEnt.FindAttribute(swAttDef,
0)
If
Not swAttCopy Is Nothing Then
Set
swFaceArr(UBound(swFaceArr)) = swFace
ReDim
Preserve swFaceArr(UBound(swFaceArr) + 1)
End
If
Set
swFace = swFace.GetNextFace
Loop
Debug.Assert
UBound(swFaceArr) >= 1
ReDim
Preserve swFaceArr(UBound(swFaceArr) - 1)
GetFacesWithAttribute
= swFaceArr
End Function
Sub main()
'
1
= Invisible
'
0
= Visible
Const
CreateVisible As
Long = 0
Const
sAttDefName As
String = "temp_attrib"
Const
sAttRootName As
String = "temp"
Dim
swApp As
SldWorks.SldWorks
Dim
swAttDef As
SldWorks.attributeDef
Dim
swModel As
SldWorks.ModelDoc2
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
swPart As
SldWorks.PartDoc
Dim
nSelCount As
Long
Dim
swFace As
SldWorks.face2
Dim
swEnt As
SldWorks.entity
Dim
swAtt() As
SldWorks.Attribute
Dim
vFaceArr As
Variant
Dim
swFeat As
SldWorks.feature
Dim
vBodies As
Variant
Dim
swBody As
SldWorks.body2
Dim
swCopyBody As
SldWorks.body2
Dim
swNewPart As
SldWorks.PartDoc
Dim
i As
Long
Dim
bRet As
Boolean
Set
swApp = Application.SldWorks
Set
swAttDef = swApp.DefineAttribute(sAttDefName)
Set
swModel = swApp.ActiveDoc
Set
swSelMgr = swModel.SelectionManager
Set
swPart = swModel
bRet
= swAttDef.Register: Debug.Assert
bRet
'
Add attribute to selected faces
nSelCount
= swSelMgr.GetSelectedObjectCount
ReDim
swAtt(nSelCount)
For
i = 1 To nSelCount
Set
swFace = swSelMgr.GetSelectedObject6(i,
-1)
Set
swEnt = swFace
Set
swAtt(i - 1) = swAttDef.CreateInstance5(swModel,
swEnt, _
sAttRootName
& i, CreateVisible, _
swAllConfiguration):
Debug.Assert Not swAtt(i - 1) Is Nothing
Next
i
vBodies
= swPart.GetBodies2(swAllBodies,
False)
Set
swBody = vBodies(0)
Set
swCopyBody = swBody.Copy
'
Remove attribute from faces
For
i = 1 To nSelCount
bRet
= swAtt(i - 1).Delete(True): Debug.Assert
bRet
Next
i
vFaceArr
= GetFacesWithAttribute(swApp, swCopyBody, swAttDef)
Debug.Assert
nSelCount = UBound(vFaceArr) + 1
'
Can only delete blends from a temporary body
Debug.Assert
swCopyBody.IsTemporaryBody
bRet
= swCopyBody.DeleteBlends3(vFaceArr,
True, True): Debug.Assert bRet
Set
swNewPart = swApp.NewPart
Set
swFeat = swNewPart.CreateFeatureFromBody3(swCopyBody,
False, swCreateFeatureBodyCheck): Debug.Assert Not swFeat Is Nothing
End Sub
'----------------------------------------