Delete Faces Example (VBA)
This example shows how to delete faces.
NOTE: You can only delete faces
from a temporary body.
'---------------------------------
'
' Preconditions:
' (1)
Part is open.
' (2)
Part only contains one solid body.
' (3)
At least one face is selected.
'
' Postconditions:
' (1)
New part is created.
' (2)
New part has same body as original part
' but
with selected faces removed.
'
' NOTE: It may not be possible to remove the
' selected
faces. If this is the case, then
' the
new body is the same as the original
' body.
'
'------------------------------------
Option Explicit
Public Enum swCreateFeatureBodyOpts_e
swCreateFeatureBodyCheck
= &H1
swCreateFeatureBodySimplify
= &H2
End Enum
Public Enum swInConfigurationOpts_e
swThisConfiguration
= 1
swAllConfiguration
= 2
swSpecifyConfiguration
= 3
End Enum
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 on a face 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 = "TDE_temp_attrib"
Const
sAttRootName As
String = "TDE"
Dim
swApp As
SldWorks.SldWorks
Dim
swAttDef As
SldWorks.attributeDef
Dim
swModel As
SldWorks.ModelDoc2
Dim
swPart As
SldWorks.PartDoc
Dim
swBody As
SldWorks.body2
Dim
swCopyBody As
SldWorks.body2
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
nSelCount As
Long
Dim
swFace As
SldWorks.face2
Dim
swEnt As
SldWorks.entity
Dim
swAtt() As
SldWorks.Attribute
Dim
vFaceArr As
Variant
Dim
swNewPart As
SldWorks.PartDoc
Dim
swNewModel As
SldWorks.ModelDoc2
Dim
swFeat As
SldWorks.feature
Dim
vBodies As
Variant
Dim
i As
Long
Dim
bLocChk As
Boolean
Dim
nRetval 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.GetSelectedObject5(i)
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,
True)
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 faces from a temporary body
Debug.Assert
swCopyBody.IsTemporaryBody
'
Should not assert because it may fail to delete faces or fail local check
or both
bRet
= swCopyBody.DeleteFaces3(vFaceArr,
2, False, bLocChk): Debug.Assert bRet: Debug.Assert bLocChk
'
Should not assert because body may be a surface body
nRetval
= swCopyBody.Check2: Debug.Assert
0 = nRetval
Set
swNewPart = swApp.NewPart
Set
swNewModel = swNewPart
Set
swFeat = swNewPart.CreateFeatureFromBody3(swCopyBody,
False, swCreateFeatureBodyCheck): Debug.Assert Not swFeat Is Nothing
End Sub
'---------------------------------