Hello!
I'm trying to autmoatically fill every region of a sketch with individual planar surfaces and i have written a macro which selects all regions of the sketch and attempts to add a surface for each one it finds. To Further calrify want i want to do, I basically want to automate Charles answer from this thread: multiple surfaces 3d sketch , but for a 2d sketch.
The problem i have is that the surfaces i add end upp in the same region, even though i select different regions before calling "InsertPlanarRefSurface()". I found this function by trying to record the process but i'm not sure if it's the right choice.
Any help or suggestion is would be highly appreciated!
This is the part of the code I'm having troubles with (some variables might be for other parts of the code that is not included):
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSketch As SldWorks.Sketch
Dim vRegions As Variant
Dim vSegments As Variant
Dim swSkRegions As SldWorks.SketchRegion
Dim swskContours As SldWorks.SketchContour
Dim swFeat As SldWorks.Feature
Dim swFeatureMgr As SldWorks.FeatureManager
Dim SelMgr As SldWorks.SelectionMgr
Dim mySelectData As SldWorks.SelectData
Dim vEdgeArr As Variant
Dim swEdge As Edge
Dim swModeler As SldWorks.Modeler
Dim boolstatus As Boolean
Dim swselmgr As SldWorks.SelectionMgr
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swFeatureMgr = swModel.FeatureManager
Set SelMgr = swModel.SelectionManager
boolstatus = swModel.Extension.SelectByID2("test_sketch", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Set swselmgr = swModel.SelectionManager
Set swFeat = swselmgr.GetSelectedObject6(1, 0)
Set swSketch = swFeat.GetSpecificFeature2
vRegions = swSketch.GetSketchRegions()
Dim i As Integer
swModel.ClearSelection2 True
For i = 0 To UBound(vRegions)
Set swSkRegions = vRegions(i)
swModel.SelectionManager.EnableContourSelection = True
swSkRegions.Select2 False, Nothing
boolstatus = swModel.InsertPlanarRefSurface()
swModel.ClearSelection2 True
swModel.SelectionManager.EnableContourSelection = False
Next
end sub
Meddelandet redigerades av: Gustav Carlberg forgot to append testpart
This is obviously a late response but I do have a solution for you although it is not elegant. I noticed if I paused the macro and manually clicked the button to create the planar surface it worked just fine so I essentially just replaced the InsertPlanarRefSurface call with these two lines:
swApp.RunCommand swCommands_InsertPlanarSurface, ""
swApp.RunCommand swCommands_Ok_Command, ""
I think it has something to do with the conversion SolidWorks does between sketch regions and sketch entities behind the scenes but for now this band-aid approach works ok. It would take longer to run with a large sketch doing it this way. I really don't like sending the OK command like that without a guarantee that the feature can be created, but like i said... band-aid.
I also added a part where I specify the mark as 1 using a SldWorks.Selectdata object with mark set to 1 but this may or may not be necessary (it certainly was not enough on its own to do the trick)
Dim swSkRegions As SldWorks.SketchRegion
Dim swskContours As SldWorks.SketchContour
Dim swFeat As SldWorks.Feature
Dim swFeatureMgr As SldWorks.FeatureManager
Dim SelMgr As SldWorks.SelectionMgr
Dim mySelectData As SldWorks.SelectData
Dim vEdgeArr As Variant
Dim swEdge As Edge
Dim swModeler As SldWorks.Modeler
Dim boolstatus As Boolean
Dim swselmgr As SldWorks.SelectionMgr
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swFeatureMgr = swModel.FeatureManager
Set SelMgr = swModel.SelectionManager
boolstatus = swModel.Extension.SelectByID2("test_sketch", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Set swselmgr = swModel.SelectionManager
Set swFeat = swselmgr.GetSelectedObject6(1, 0)
Set swSketch = swFeat.GetSpecificFeature2
vRegions = swSketch.GetSketchRegions()
Dim i As Integer
swModel.ClearSelection2 True
Dim swseldata As SelectData
Set swseldata = swModel.SelectionManager.CreateSelectData
swseldata.Mark = 1
For i = 0 To UBound(vRegions)
Set swSkRegions = vRegions(i)
swModel.SelectionManager.EnableContourSelection = True
swSkRegions.Select2 False, swseldata
swApp.RunCommand swCommands_InsertPlanarSurface, ""
swApp.RunCommand swCommands_Ok_Command, ""
'''remove''''boolstatus = swModel.InsertPlanarRefSurface()
swModel.ClearSelection2 True
swModel.SelectionManager.EnableContourSelection = False
swModel.ClearSelection2 True
Next
End Sub