A macro to split a cylindrical surface with two planar surfaces, the end result is a quater of a cylinder. The trimmed surface is then mirrored about the plane.
The result needed is not always be the same quater of the surface (see EndSurface.SLDPART)
How to obtain the trimmmed surface? Trim type - Mutual
How to choose in the program/code which quadtrant to retain?
I have recorded the macro and run it but doest not give the result (see Recorded code below)
By adding the names to the sufaces, the code selects the surfaces (see Modified Code below) but with out end result (a quater of a surface).
See the attached files for intial model and the final result. (startSurface.SLDPART and EndSurface.SLDPART).
___________________________________________------Recorded code---------------------------------_______________________________
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("", "SURFACEBODY", -8.07831735336606E-02, 0.12533729501655, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("", "SURFACEBODY", 0, 0.112408979389443, -9.00572071890338E-02, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("", "SURFACEBODY", -5.68650625939711E-02, 4.60407418556201E-02, 3.78374670210064E-02, True, 0, Nothing, 0)
boolstatus = Part.FeatureManager.PreTrimSurface(True, False, False, False)
Dim myModelView As Object
Set myModelView = Part.ActiveView
' Roll View
Dim swModelView As Object
Set swModelView = Part.ActiveView
swModelView.RollBy 0
Dim myFeature As Object
Set myFeature = Part.FeatureManager.PostTrimSurface(True)
End Sub
________________________________________________________________________________________________________________
-----------------------------------------------------------------------------------------Modified Code------------------------------------------------------------------------------
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
'--------------------------------------------------Added the names of surfaces------------------------------------------------------
boolstatus = Part.Extension.SelectByID2("Surface1", "SURFACEBODY", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Surf_Plane1", "SURFACEBODY", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Surf_Plane2", "SURFACEBODY", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = Part.FeatureManager.PreTrimSurface(True, False, False, False)
Dim myModelView As Object
Set myModelView = Part.ActiveView
' Roll View
Dim swModelView As Object
Set swModelView = Part.ActiveView
swModelView.RollBy 0
Dim myFeature As Object
Set myFeature = Part.FeatureManager.PostTrimSurface(True)
End Sub
------------------------------------------------------------------------------------------------------------------------
Thank you in advance for the help.
Hi Raghu,
You need to make an additional selection before calling PostTrimSurface. The pre-selection defines the mutual trimming surfaces. The additional selection should be a coordinate-based selection to choose the face to keep. So you cannot select by name on the final selection.
Another detail to consider is that the final selection by location could pick two surfaces since Surface1 and Surface2 are identical in your example. Hide the one that shouldn't be trimmed before calling the trimming operation. The following code should work as long as you have Surface1 hidden.
Dim swApp As SldWorks.SldWorks
Dim Part As ModelDoc2
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
'select the mutual trimming surfaces by name or location
boolstatus = Part.Extension.SelectByID2("Surf_Plane1", "SURFACEBODY", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Surf_Plane2", "SURFACEBODY", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Surface2", "SURFACEBODY", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = Part.FeatureManager.PreTrimSurface(True, True, False, False)
'select the surface to keep by an x, y, z coordinate
boolstatus = Part.Extension.SelectByID2("", "SURFACEBODY", -0.054599769773688, 3.10354428007713E-02, -4.10386938759757E-02, True, 0, Nothing, 0)
Dim myFeature As Object
Set myFeature = Part.FeatureManager.PostTrimSurface(True)
End Sub
Mike