Hi, I want to traverse through the feature tree and check whether the particular plane is already available and if not, pop up a message to user "Plane is not available. Want to create it?". If yes then create it using offset to reference planes and if No then stop the macro.
Thanks!
Hi Deepak,
There are some examples in the help files that can get you started:
Traverse the features:
and check for the name.
There is also an example that does the second part:
2019 SOLIDWORKS API Help - Create and Name Planes Example (VBA)
Eddy
Is there any specific program to notify duplicating a plane?
Just to add couple of more options:
2015 SOLIDWORKS API Help - IsNameUsed Method (IFeatureManager)
2012 SOLIDWORKS API Help - FeatureByName Method (IPartDoc) and if result is not Nothing then feature with this name exist
Hi Eddy and Artem,
Thanks a lot for the help. I could be able to get it done. Here is the code for the same -
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim instance0 As IFeatureManager
Dim Tpe As Integer
Dim Name As String
Dim ivalue As Boolean
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
If Part Is Nothing Then
Dim Response As Integer
Response = MsgBox("No active Part found. Want to Create a Part file?", vbQuestion + vbYesNo + vbDefaultButton2, "Missining Part Alert")
If Response = vbYes Then
Dim swSheetWidth As Double
swSheetWidth = 0
Dim swSheetHeight As Double
swSheetHeight = 0
Set Part = swApp.NewDocument("C:\ProgramData\SolidWorks\SOLIDWORKS 2018\templates\Part.prtdot", 0, swSheetWidth, swSheetHeight)
Dim Output As Integer
Output = MsgBox("Part will be Created in C:\ProgramData\SolidWorks\SOLIDWORKS 2018\templates", vbInformation + vbOKOnly + vbDefaultButton2, "Part Directory Information")
Dim swPart As PartDoc
Set swPart = Part
swApp.ActivateDoc2 "Part1", False, longstatus
Set Part = swApp.ActiveDoc
Else
Exit Sub
End If
End If
Tpe = 1
Name = "Head Height"
Set instance0 = Part.FeatureManager
ivalue = instance0.IsNameUsed(Tpe, Name)
Debug.Print ivalue
If ivalue = False Then
'MsgBox ("Head Height Plane is not created. Want to create it?")
Dim answer As Integer
answer = MsgBox("Head Height Plane is not created. Want to create it?", vbQuestion + vbYesNo + vbDefaultButton2, "Missining Plane Alert")
If answer = vbYes Then
boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, True, 0, Nothing, 0)
Dim myRefPlane As Object
Set myRefPlane = Part.FeatureManager.InsertRefPlane(8, 0.431569494403922, 0, 0, 0, 0)
Part.ClearSelection2 True
Dim Plane1 As Feature
Dim NPlane1 As String
Set Plane1 = Part.Extension.GetLastFeatureAdded()
NPlane1 = Plane1.Name
Debug.Print NPlane1
boolstatus = Part.Extension.SelectByID2(NPlane1, "PLANE", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "Head Height")
Part.ClearSelection2 True
Part.ForceRebuild3 False
End If
If answer = vbNo Then
Exit Sub
End If
End If
End Sub
Hi Eddy and Artem,
Thanks a lot for the help. I could be able to get it done. Here is the code for the same -
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim instance0 As IFeatureManager
Dim Tpe As Integer
Dim Name As String
Dim ivalue As Boolean
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
If Part Is Nothing Then
Dim Response As Integer
Response = MsgBox("No active Part found. Want to Create a Part file?", vbQuestion + vbYesNo + vbDefaultButton2, "Missining Part Alert")
If Response = vbYes Then
Dim swSheetWidth As Double
swSheetWidth = 0
Dim swSheetHeight As Double
swSheetHeight = 0
Set Part = swApp.NewDocument("C:\ProgramData\SolidWorks\SOLIDWORKS 2018\templates\Part.prtdot", 0, swSheetWidth, swSheetHeight)
Dim Output As Integer
Output = MsgBox("Part will be Created in C:\ProgramData\SolidWorks\SOLIDWORKS 2018\templates", vbInformation + vbOKOnly + vbDefaultButton2, "Part Directory Information")
Dim swPart As PartDoc
Set swPart = Part
swApp.ActivateDoc2 "Part1", False, longstatus
Set Part = swApp.ActiveDoc
Else
Exit Sub
End If
End If
Tpe = 1
Name = "Head Height"
Set instance0 = Part.FeatureManager
ivalue = instance0.IsNameUsed(Tpe, Name)
Debug.Print ivalue
If ivalue = False Then
'MsgBox ("Head Height Plane is not created. Want to create it?")
Dim answer As Integer
answer = MsgBox("Head Height Plane is not created. Want to create it?", vbQuestion + vbYesNo + vbDefaultButton2, "Missining Plane Alert")
If answer = vbYes Then
boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, True, 0, Nothing, 0)
Dim myRefPlane As Object
Set myRefPlane = Part.FeatureManager.InsertRefPlane(8, 0.431569494403922, 0, 0, 0, 0)
Part.ClearSelection2 True
Dim Plane1 As Feature
Dim NPlane1 As String
Set Plane1 = Part.Extension.GetLastFeatureAdded()
NPlane1 = Plane1.Name
Debug.Print NPlane1
boolstatus = Part.Extension.SelectByID2(NPlane1, "PLANE", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "Head Height")
Part.ClearSelection2 True
Part.ForceRebuild3 False
End If
If answer = vbNo Then
Exit Sub
End If
End If
End Sub