The SelectbyID2 is not selecting the part.
What is truly strange is that it will work on a co-workers PC but Not on my PC. We have the exact same PC build (even ordered at same time) I looked at reference libraries and we have the same ones checked. We used it one the exact same model from the network drive and clicked on the same selections at beginning of the macro. It will create the features in assembly, it just fails at the selecting the part the macro creates. She wrote the macro on her PC.
'*********************************************************************************************************************
'INPUTS
'1. Either a face on ground plane or a ground plane
'2. one edge for the front plane to be coincident to one of the perimeter vertical walls
'3. 4 points to determine the location of the other faces of the crate
'*************************************************************************************************************************
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swComponent As SldWorks.Component2
Dim swFeature As Object
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFeat As SldWorks.Feature
Dim swfeatpoint As SldWorks.Feature
Dim swAssemFeat As SldWorks.Feature
Dim swExt As ModelDocExtension
Dim swSketchManager As SketchManager
Dim swSketch As SldWorks.Sketch
Dim swSketchPt As SldWorks.SketchPoint
Dim swSeg As SldWorks.SketchSegment
Dim swPart As SldWorks.PartDoc
Dim swBody As SldWorks.Body2
Dim swFace As SldWorks.Face2
Dim swEntity As SldWorks.Entity
Dim myRefPlane As RefPlane
Dim boolstatus As Boolean
Dim AssemPath As String
Dim AssemName As String
Dim status As Long
Dim Response As Integer
Sub main()
Response = MsgBox("You need the following for the creation of the crate: " & vbCrLf & _
"1. A Face or plane for where the bottom of the crate will be" & vbCrLf & _
"2. A straight edge or line where one of the four walls of the crate will be" & vbCrLf & _
"3. Points where the remaining faces of the crate will be" & vbCrLf & _
"Do you have all of these things?", vbYesNo)
If Response = vbNo Then
MsgBox ("Please create them and run again.")
Exit Sub
End If
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swAssy = swModel
Set swSelMgr = swModel.SelectionManager
'This is where the macro creates the assemname variable
'Getting assembly part number
AssemName = swAssy.GetTitle()
'DebugMsgBox ("Assembly file name: " + vbCrLf + AssemName)
'Find the File Path of the Assembly file
AssemPath = swApp.GetCurrentWorkingDirectory
Response = MsgBox("Is this the File Path where the Assembly is saved?: " + vbCrLf + AssemPath, vbYesNo)
If Response = vbNo Then
MsgBox ("Get the Working Directory to match where the Assembly is saved and run again")
Exit Sub
End If
'Here is where the new part is created
' Create the part and insert it as a virtual component in the assembly
boolstatus = swAssy.InsertNewVirtualPart(swFeature, swComponent)
'DebugMsgBox ("Virtual component was created: " & boolstatus)
'Create the file name of the Crate from the Assembly part number
Dim CratePartName As String
CratePartName = AssemName + "-800"
swComponent.Name2 = CratePartName
'DebugMsgBox ("Crate Part file name changed to: " & vbCrLf & swComponent.Name2)
'At this point selectbyID2 works and it does so until planes are created in assembly
'Select the crate part
boolstatus = swModel.Extension.SelectByID2(swComponent.Name2 + "@" + AssemName, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
'DebugMsgBox ("Crate Part was Selected: " & boolstatus)
'Set crate part as a envelope component
'boolstatus = swModel.CompConfigProperties6(2, 0, True, True, "Default", False, True, 0)
'DebugMsgBox ("Crate Part change to an Envelope Component: " & boolstatus)
boolstatus = swModel.EditRebuild3()
'DebugMsgbox("Rebuild was successful: " & boolstatus)
'Unfix the crate part and mate its origin with the assembly origin
boolstatus = swModel.Extension.SelectByID2(swComponent.Name2 + "@" + AssemName, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
swModel.UnfixComponent
swModel.ClearSelection2 True
'All planes are successfully created
'Mating the planes of the component to the planes of the assembly
Set swFeat = swComponent.FirstFeature
Dim bret As Boolean
Dim swmate As Mate2
Dim i As Integer
i = 1
Do While i <= 3
If "RefPlane" = swFeat.GetTypeName Then
'DebugMsgBox (swFeat.Name)
Dim PlaneName As String
If "Front Plane" = swFeat.Name Then
PlaneName = "Front Plane"
End If
If "Top Plane" = swFeat.Name Then
PlaneName = "Top Plane"
End If
If "Right Plane" = swFeat.Name Then
PlaneName = "Right Plane"
End If
If PlaneName = swFeat.Name Then
boolstatus = swFeat.Select2(False, 0)
'DebugMsgBox ("Component " & PlaneName & " is selected: " & boolstatus)
boolstatus = swModel.Extension.SelectByID2(PlaneName, "PLANE", 0, 0, 0, True, 0, Nothing, 0)
'DebugMsgBox ("Assembly " & PlaneName & " is Selected: " & boolstatus)
Set swmate = swAssy.AddMate5(0, 0, False, 0, 0, 0, 0, 0, 0, 0, 0, False, False, 0, status)
swModel.ClearSelection2 True
swModel.EditRebuild3
End If
i = i + 1
End If
Set swFeat = swFeat.GetNextFeature
Loop
swModel.ForceRebuild3 True
'Creating CRATE GROUND Plane in assembly
Dim Plane As String
swModel.ClearSelection2 True
MsgBox "Please select a face or plane for the placement of the ground plane..."
While swSelMgr.GetSelectedObjectCount2(-1) < 1
DoEvents
Wend
Set myRefPlane = swModel.FeatureManager.InsertRefPlane(4, 0, 0, 0, 0, 0)
Set swAssemFeat = swModel.FeatureByPositionReverse(0)
Plane = swAssemFeat.Name
MsgBox (Plane)
boolstatus = swModel.Extension.SelectByID2(Plane, "PLANE", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "CRATE GROUND")
'Creating FRONT Plane in assembly
swModel.ClearSelection2 True
MsgBox "Select an straight edge or a line for the Front Plane to be coincident to..."
While swSelMgr.GetSelectedObjectCount2(-1) < 1
DoEvents
Wend
boolstatus = swModel.Extension.SelectByID2("CRATE GROUND", "PLANE", 0, 0, 0, True, 1, Nothing, 0)
Set myRefPlane = swModel.FeatureManager.InsertRefPlane(4, 0, 2, 0, 0, 0)
Set swAssemFeat = swModel.FeatureByPositionReverse(0)
Plane = swAssemFeat.Name
boolstatus = swModel.Extension.SelectByID2(Plane, "PLANE", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "FRONT")
'Creating RIGHT Plane in assembly
swModel.ClearSelection2 True
MsgBox "Select the point to create the Right Plane..."
While swSelMgr.GetSelectedObjectCount2(-1) < 1
DoEvents
Wend
boolstatus = swModel.Extension.SelectByID2("CRATE GROUND", "PLANE", 0, 0, 0, True, 1, Nothing, 0)
boolstatus = swModel.Extension.SelectByID2("FRONT", "PLANE", 0, 0, 0, True, 2, Nothing, 0)
Set myRefPlane = swModel.FeatureManager.InsertRefPlane(4, 0, 2, 0, 2, 0)
Set swAssemFeat = swModel.FeatureByPositionReverse(0)
Plane = swAssemFeat.Name
boolstatus = swModel.Extension.SelectByID2(Plane, "PLANE", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "RIGHT")
'Creating LEFT Plane in assembly
swModel.ClearSelection2 True
MsgBox "Select the point to create the Left Plane..."
While swSelMgr.GetSelectedObjectCount2(-1) < 1
DoEvents
Wend
boolstatus = swModel.Extension.SelectByID2("CRATE GROUND", "PLANE", 0, 0, 0, True, 1, Nothing, 0)
boolstatus = swModel.Extension.SelectByID2("FRONT", "PLANE", 0, 0, 0, True, 2, Nothing, 0)
Set myRefPlane = swModel.FeatureManager.InsertRefPlane(4, 0, 2, 0, 2, 0)
Set swAssemFeat = swModel.FeatureByPositionReverse(0)
Plane = swAssemFeat.Name
boolstatus = swModel.Extension.SelectByID2(Plane, "PLANE", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "LEFT")
'Creating BACK Plane in assembly
swModel.ClearSelection2 True
MsgBox "Select the point to create the Back Plane..."
While swSelMgr.GetSelectedObjectCount2(-1) < 1
DoEvents
Wend
boolstatus = swModel.Extension.SelectByID2("FRONT", "PLANE", 0, 0, 0, True, 1, Nothing, 0)
Set myRefPlane = swModel.FeatureManager.InsertRefPlane(4, 0, 1, 0, 0, 0)
Set swAssemFeat = swModel.FeatureByPositionReverse(0)
Plane = swAssemFeat.Name
boolstatus = swModel.Extension.SelectByID2(Plane, "PLANE", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "BACK")
'Creating TOP Plane in assembly
swModel.ClearSelection2 True
MsgBox "Select the point to create the Top Plane..."
While swSelMgr.GetSelectedObjectCount2(-1) < 1
DoEvents
Wend
boolstatus = swModel.Extension.SelectByID2("CRATE GROUND", "PLANE", 0, 0, 0, True, 1, Nothing, 0)
Set myRefPlane = swModel.FeatureManager.InsertRefPlane(4, 0, 1, 0, 0, 0)
Set swAssemFeat = swModel.FeatureByPositionReverse(0)
Plane = swAssemFeat.Name
boolstatus = swModel.Extension.SelectByID2(Plane, "PLANE", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "TOP")
'This is where selection of the part fails
'Select the crate part
boolstatus = swModel.Extension.SelectByID2(swComponent.Name2 + "@" + AssemName, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
MsgBox ("Crate Part was Selected: " & boolstatus)
'Editing selected part
Dim Silent As Boolean
Dim AllowReadOnly As Boolean
Dim Information As Long
boolstatus = swAssy.EditPart2(Silent, AllowReadOnly, Information)
'MsgBox (boolstatus)
'Creating a plane in crate part coincident to assembly ground plane
boolstatus = swModel.Extension.SelectByID2("CRATE GROUND", "PLANE", 0, 0, 0, True, 0, Nothing, 0)
Set myRefPlane = swModel.FeatureManager.InsertRefPlane(4, 0, 0, 0, 0, 0)
'Select Created Plane
Set swFeat = swComponent.FirstFeature (Where debug goes when macro fails)
Do While Not swFeat Is Nothing
'debugMsgBox (swFeat.GetTypeName & vbCrLf & swFeat.Name)
If "RefPlane" = swFeat.GetTypeName Then
'debugMsgBox (swFeat.Name)
If "Plane1" = swFeat.Name Then
boolstatus = swFeat.Select2(False, 0)
Exit Do
End If
End If
Set swFeat = swFeat.GetNextFeature
Loop
'Changing created planes name
boolstatus = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "Crate Plane")
'DebugMsgBox ("Plane name Changed: " & boolstatus)
'Creating bounding box points
CreatingBBPoints swModel
'Selecting the 3D sketch with boundary points
Set swFeat = swFeat.GetNextFeature
'DebugMsgBox (swFeat.Name)
boolstatus = swFeat.Select2(False, 0)
'Getting coordinates of Boundary points
Set swSelMgr = swModel.SelectionManager
Set swfeatpoint = swSelMgr.GetSelectedObject6(1, -1)
Set swSketch = swfeatpoint.GetSpecificFeature2
Dim sketchPointArray As Variant
sketchPointArray = swSketch.GetSketchPoints2
Dim t As Long
t = 0
Dim x1 As Double
Dim y1 As Double
Dim z1 As Double
Dim x2 As Double
Dim y2 As Double
Dim z2 As Double
Dim x3 As Double
Dim y3 As Double
Dim z3 As Double
For t = 0 To UBound(sketchPointArray)
' Get the x & y coordinates
If t = 0 Then
x1 = sketchPointArray(t).X
y1 = sketchPointArray(t).Y
z1 = sketchPointArray(t).Z
End If
If t = 1 Then
x2 = sketchPointArray(t).X
y2 = sketchPointArray(t).Y
z2 = sketchPointArray(t).Z
End If
If t = 2 Then
x3 = sketchPointArray(t).X
y3 = sketchPointArray(t).Y
z3 = sketchPointArray(t).Z
End If
Next t
'Finding Height of Crate
Dim BBHeight As Double
Dim BBheight2 As Double
Dim Height As Double
Dim MeasureTool As SldWorks.Measure
Set swExt = swModel.Extension
Set MeasureTool = swExt.CreateMeasure
swModel.ClearSelection2 True
'Selecting plane and point to measure from
boolstatus = swModel.Extension.SelectByID2("Crate Plane" + "@" + swComponent.Name2 + "@" + AssemName, "PLANE", 0, 0, 0, True, 0, Nothing, 0)
'DebugMsgBox ("Crate Plane selected: " & bret)
boolstatus = swModel.Extension.SelectByID2("", "EXTSKETCHPOINT", x1, y1, z1, True, 0, Nothing, 0)
'DebugMsgBox ("Point Selected: " & boolstatus)
'Measure distance between point and plane
boolstatus = MeasureTool.Calculate(Nothing)
'DebugMsgBox ("distance was measured: " & boolstatus)
BBHeight = MeasureTool.NormalDistance
swModel.ClearSelection2 True
'Select plane and point to measure
boolstatus = swModel.Extension.SelectByID2("Crate Plane" + "@" + swComponent.Name2 + "@" + AssemName, "PLANE", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = swModel.Extension.SelectByID2("", "EXTSKETCHPOINT", x2, y2, z2, True, 0, Nothing, 0)
'Measure distance between point and plane
boolstatus = MeasureTool.Calculate(Nothing)
BBheight2 = MeasureTool.NormalDistance
swModel.ClearSelection2 True
'Selecting the larger distance
If BBHeight > BBheight2 Then
Height = BBHeight
End If
If BBheight2 > BBHeight Then
Height = BBheight2
End If
'Selecting crate plane
boolstatus = swModel.Extension.SelectByID2("Crate Plane" + "@" + swComponent.Name2 + "@" + AssemName, "PLANE", 0, 0, 0, True, 0, Nothing, 0)
'DebugMsgBox ("Crate Plane selected: " & boolstatus)
swModel.SketchManager.InsertSketch True
swModel.ClearSelection2 True
'converting bounding box points to the crate plane
boolstatus = swModel.Extension.SelectByID2("", "EXTSKETCHPOINT", x1, y1, z1, False, 0, Nothing, 0)
boolstatus = swModel.Extension.SelectByID2("", "EXTSKETCHPOINT", x2, y2, z2, True, 0, Nothing, 0)
boolstatus = swModel.Extension.SelectByID2("", "EXTSKETCHPOINT", x3, y3, z3, True, 0, Nothing, 0)
boolstatus = swModel.SketchManager.SketchUseEdge3(False, False)
swModel.SketchManager.InsertSketch True
'Getting coordinates of converted points
Set swSelMgr = swModel.SelectionManager
Set swfeatpoint = swSelMgr.GetSelectedObject6(1, -1)
Set swSketch = swfeatpoint.GetSpecificFeature2
Dim sketchPointArray2 As Variant
sketchPointArray2 = swSketch.GetSketchPoints2
Dim p As Long
p = 0
Dim xvalue1 As Double
Dim yvalue1 As Double
Dim xvalue2 As Double
Dim yvalue2 As Double
Dim xvalue3 As Double
Dim yvalue3 As Double
For p = 0 To UBound(sketchPointArray2)
' Get the x & y coordinates
If p = 0 Then
xvalue1 = sketchPointArray2(p).X
yvalue1 = sketchPointArray2(p).Y
End If
If p = 1 Then
xvalue2 = sketchPointArray2(p).X
yvalue2 = sketchPointArray2(p).Y
End If
If p = 2 Then
xvalue3 = sketchPointArray2(p).X
yvalue3 = sketchPointArray2(p).Y
End If
Next p
'Create Corner Rectangle from converted points
Set swFeat = swFeat.GetNextFeature
'DebudMsgBox (swFeat.Name)
swModel.EditSketch
Dim vSkLines As Variant
vSkLines = swModel.SketchManager.Create3PointCornerRectangle(xvalue1, yvalue1, 0, xvalue3, yvalue3, 0, xvalue2, yvalue2, 0)
'Converts selected sketches to construction lines
swModel.SketchManager.CreateConstructionGeometry
'Selects lines of rectangle
boolstatus = swModel.Extension.SelectByID2("Line2", "SKETCHSEGMENT", 0, 0, 0, False, 1, Nothing, 0)
boolstatus = swModel.Extension.SelectByID2("Line1", "SKETCHSEGMENT", 0, 0, 0, True, 1, Nothing, 0)
boolstatus = swModel.Extension.SelectByID2("Line4", "SKETCHSEGMENT", 0, 0, 0, True, 1, Nothing, 0)
boolstatus = swModel.Extension.SelectByID2("Line3", "SKETCHSEGMENT", 0, 0, 0, True, 1, Nothing, 0)
'Offset rectangle by 2 inches
boolstatus = swModel.SketchManager.SketchOffset2(0.0508, False, True, 0, 0, True)
swModel.SketchManager.InsertSketch True
'Select offset rectangle sketch
boolstatus = swFeat.Select2(False, 0)
'Extrudes crate 2 inches past the calculated crate height from above
Dim extrude As Object
Set extrude = swModel.FeatureManager.FeatureExtrusion3(True, False, True, 0, 0, Height + 0.0508, 0, False, False, False, False, 0, 0, False, False, False, False, False, True, True, 0, 0, False)
'selecting face to be shelled
Dim vbodies As Variant
Dim b As Long
vbodies = swComponent.GetBodies3(0, True)
For b = 0 To UBound(vbodies)
Set swBody = vbodies(b)
Set swFace = swBody.GetFirstFace
Do While Not swFace Is Nothing
swModel.ClearSelection2 True
Set swEntity = swFace
boolstatus = swEntity.Select4(False, Nothing)
'debugMsgBox ("Face Selected: " & boolstatus)
'Select Crate Plane
boolstatus = swModel.Extension.SelectByID2("Crate Plane" + "@" + swComponent.Name2 + "@" + AssemName, "PLANE", 0, 0, 0, True, 0, Nothing, 0)
'Measure distance between face and plane
boolstatus = False
boolstatus = MeasureTool.Calculate(Nothing)
'MsgBox ("distance was measured: " & boolstatus)
If (MeasureTool.IsParallel) Then
If (MeasureTool.IsIntersect) Then
Exit Do
End If
End If
Set swFace = swFace.GetNextFace
Loop
Next b
swModel.ClearSelection2 True
boolstatus = swEntity.Select4(False, Nothing)
'debugMsgBox ("Face Selected: " & boolstatus)
'Shelling Selected Face
swModel.InsertFeatureShell 0.047625, False
'Closing edit component in assembly
swAssy.EditAssembly
'Saving virtual component externally
boolstatus = swModel.Extension.SelectByID2(swComponent.Name2 + "@" + AssemName, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Set swComponent = swSelMgr.GetSelectedObject6(1, -1)
boolstatus = swModel.SetComponentTransparent(True)
boolstatus = swComponent.SaveVirtualComponent(AssemPath + CratePartName + ".sldprt")
'DebugMsgBox ("Crate Part was saved externally: " & boolstatus)
swModel.ClearSelection2 True
End Sub
Sub CreatingBBPoints(model As SldWorks.ModelDoc2)
Dim bool As Boolean
model.SketchManager.Insert3DSketch True
Dim skPoint As Object
Set skPoint = model.SketchManager.CreatePoint(-0.123642, 0.014769, -1)
bool = model.Extension.SelectByID2("CRATE GROUND", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
bool = model.Extension.SelectByID2("BACK", "PLANE", 0, 0, 0, True, 0, Nothing, 0)
bool = model.Extension.SelectByID2("Point1", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
model.SketchAddConstraints "sgATINTERSECT"
model.ClearSelection2 True
bool = model.Extension.SelectByID2("LEFT", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
bool = model.Extension.SelectByID2("Point1", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
model.SketchAddConstraints "sgCOINCIDENT"
model.ClearSelection2 True
Dim skPoint2 As Object
Set skPoint2 = model.SketchManager.CreatePoint(-1, 0.014769, 1)
bool = model.Extension.SelectByID2("TOP", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
bool = model.Extension.SelectByID2("FRONT", "PLANE", 0, 0, 0, True, 0, Nothing, 0)
bool = model.Extension.SelectByID2("Point2", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
model.SketchAddConstraints "sgATINTERSECT"
model.ClearSelection2 True
bool = model.Extension.SelectByID2("RIGHT", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
bool = model.Extension.SelectByID2("Point2", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
model.SketchAddConstraints "sgCOINCIDENT"
model.ClearSelection2 True
Dim skPoint3 As Object
Set skPoint3 = model.SketchManager.CreatePoint(-1, 0.014769, 1)
bool = model.Extension.SelectByID2("TOP", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
bool = model.Extension.SelectByID2("BACK", "PLANE", 0, 0, 0, True, 0, Nothing, 0)
bool = model.Extension.SelectByID2("Point3", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
model.SketchAddConstraints "sgATINTERSECT"
model.ClearSelection2 True
bool = model.Extension.SelectByID2("RIGHT", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
bool = model.Extension.SelectByID2("Point3", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
model.SketchAddConstraints "sgCOINCIDENT"
model.ClearSelection2 True
model.SketchManager.InsertSketch True
model.ClearSelection2 True
End Sub