6 Replies Latest reply on Nov 20, 2014 9:00 AM by Sanya Shmidt

    How to pattern Virtual parts?

    Sanya Shmidt

      Hello guys!

      I`m just curious if anyone did that already and can help me with the code. The script below is for adding one instance of the virtual part into the assembly.

       

                          swModel = swApp.ActiveDoc

                          swSelMgr = swModel.SelectionManager

                          If swModel.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0) = False Then

                              Debug.Print("Failed to select Front plane; check feature name.")

                              Exit Sub

                           End If

       

                          swPlaneFeature = swSelMgr.GetSelectedObject6(1, -1)

                          swPlane = swPlaneFeature.GetSpecificFeature2

                          swAssem = swModel

       

                          lResult = swAssem.InsertNewVirtualPart(swPlane, swVirtComp)

                          swVirtComp.Name2 = sVirtPart

       

      What if I need to add 20 items? How should I approach?

       

      The other question I have : How to properly change custom properties of the newly added Virtual part?

       

      I`m doing the following, but its not working...

       

      ' selecting virtual component

      boolstatus = swModel.Extension.SelectByID2(swVirtComp.Name2 & "@" & swModel.GetTitle, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

       

      swSelMgr = swModel.SelectionManager

      swComp = swSelMgr.GetSelectedObjectsComponent2(1)

      swCompModel = swComp.GetModelDoc

      swCompModel.CustomInfo2(swCompModel.GetActiveConfiguration.Name, "Description") = "New VALUE"

       

       

      Thank you

      Alex.

        • Re: How to pattern Virtual parts?
          Deepak Gupta

          For inserting multiple virtual components try these codes:

           

          Option Explicit

          Sub main()

              Dim swApp As SldWorks.SldWorks

              Dim swModel As SldWorks.ModelDoc2

              Dim swSelMgr As SldWorks.SelectionMgr

              Dim swPlaneFeature As SldWorks.Feature

              Dim swPlane As SldWorks.RefPlane

              Dim swAssem As SldWorks.AssemblyDoc

              Dim i As Integer   

              Dim swVirtComp As SldWorks.Component2

             

              Set swApp = Application.SldWorks

              Set swModel = swApp.ActiveDoc

              Set swSelMgr = swModel.SelectionManager

             

              If swModel.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0) = False Then

                  Debug.Print "Failed to select Front plane; check feature name."

                  Exit Sub

              End If       

              Set swPlaneFeature = swSelMgr.GetSelectedObject6(1, -1)

              Set swPlane = swPlaneFeature.GetSpecificFeature2

              Set swAssem = swModel

           

              For i = 0 To 20

              swAssem.InsertNewVirtualPart swPlane, swVirtComp

              Next i   

              swAssem.ClearSelection2 True

             

          End Sub

            • Re: How to pattern Virtual parts?
              Sanya Shmidt

              Thank you Deepak for your respond.

              The code above creates the first instance of the part with the correct name and the rest of them just Part^2, Part^3 etc...Is there any way to correct this?

              Please see the video below.

               

              https://dl.dropboxusercontent.com/u/23443066/VirtParts.avi

               

               

              Thank you.

                • Re: How to pattern Virtual parts?
                  Deepak Gupta

                  Try these following one:

                   

                  Also would suggest to upload the attachments here instead of external sites.

                   

                  Option Explicit

                  Sub main()

                      Dim swApp As SldWorks.SldWorks

                      Dim swModel As SldWorks.ModelDoc2

                      Dim swSelMgr As SldWorks.SelectionMgr

                      Dim swPlaneFeature As SldWorks.Feature

                      Dim swPlane As SldWorks.RefPlane

                      Dim swAssem As SldWorks.AssemblyDoc

                      Dim i As Integer

                      Dim lResult As Long

                      Dim swVirtComp As SldWorks.Component2

                      Dim swSecondComp As SldWorks.Component2

                      Dim sVirtPart As String

                        

                      Set swApp = Application.SldWorks

                      Set swModel = swApp.ActiveDoc

                      Set swSelMgr = swModel.SelectionManager

                    

                      If swModel.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0) = False Then

                          Debug.Print "Failed to select Front plane; check feature name."

                          Exit Sub

                      End If

                      Set swPlaneFeature = swSelMgr.GetSelectedObject6(1, -1)

                      Set swPlane = swPlaneFeature.GetSpecificFeature2

                      Set swAssem = swModel

                      lResult = swAssem.InsertNewVirtualPart(swPlane, swVirtComp)

                      swVirtComp.Name2 = sVirtPart

                     

                      If lResult = swInsertNewPartError_NoError Then

                          For i = 1 To 20

                              Set swSecondComp = swAssem.AddComponent5(swVirtComp.GetPathName, swAddComponentConfigOptions_CurrentSelectedConfig, "", False, "", 0.1, 0, 0)

                          Next i

                      End If

                         swAssem.ClearSelection2 True

                    

                  End Sub

                    • Re: How to pattern Virtual parts?
                      Sanya Shmidt

                      Thank you.

                      Now it`s working great!

                       

                      Do you know the answer to my 2nd question about assigning custom properties to a virtual part?

                       

                      Alex.

                        • Re: How to pattern Virtual parts?
                          Deepak Gupta

                          Insert these codes:

                              Dim Part As Object

                              Dim Errors As Long

                              Set Part = swApp.ActivateDoc3(swVirtComp.GetPathName, False, 1, Errors)

                              Set Part = swApp.ActiveDoc

                              Part.CustomInfo2(Part.GetActiveConfiguration.Name, "Description") = "New VALUE" 'This is for updating an existing property.

                              swApp.CloseDoc Part.GetTitle

                          after     

                          swVirtComp.Name2 = sVirtPart
                            • Re: How to pattern Virtual parts?
                              Sanya Shmidt

                              Finally I finished this code with the help of Bob Hanson. Thank you Bob.

                               

                              Below is the working code, that checks if virtual part/pattern already exists, if it does it gets the qty and changes it to a new value. If it doesn`t exist it adds an instance and creates a linear pattern. Also it checks if the user typed 0(zero) in this case it deletes the virtual part.

                               

                              Try

                                              swModel = swApp.ActiveDoc

                                              swAssem = CType(swModel, AssemblyDoc)

                                              swSelMgr = swModel.SelectionManager

                               

                                              'checking for existence

                                              Dim PatternFeature As Feature

                                              PatternFeature = swAssem.FeatureByName(sVirtPart + "-Pattern")

                               

                                              Dim FeatureQty As Dimension  'weird ? qty is DIM?

                                              Dim reVal As Integer

                               

                                              If Not PatternFeature Is Nothing Then

                                                 ' checking if we need to delete the part

                                                  If vp_qty = 0 Then

                                                      If swModel.Extension.SelectByID2(sVirtPart + "^" + swModel.GetTitle + "-1@" + swModel.GetTitle, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0) = False Then                          

                                                 Debug.Print("Failed to select part ; check feature name.")

                                                          Exit Sub

                                                      End If

                               

                                                      ' deleting the part

                                                      swModel.Extension.DeleteSelection2(swDeleteSelectionOptions_e.swDelete_Children)

                                                      swModel.ForceRebuild3(False)

                                                      Exit Sub

                               

                                                  End If

                               

                                                  FeatureQty = swModel.Parameter("D1@" + sVirtPart + "-Pattern")

                                                  reVal = FeatureQty.SetSystemValue3(vp_qty, swSetValueInConfiguration_e.swSetValue_InAllConfigurations, Nothing)

                                                  swModel.ForceRebuild3(False)

                                                  Exit Sub

                                              End If

                               

                                             ' choosing the plane to drop Virtual part on

                                              If swModel.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0) = False Then

                                                  Debug.Print("Failed to select Front plane; check feature name.")

                                                  Exit Sub

                                              End If

                               

                                              swPlaneFeature = swSelMgr.GetSelectedObject6(1, -1)

                                              swPlane = swPlaneFeature.GetSpecificFeature2

                               

                                              lResult = swAssem.InsertNewVirtualPart(swPlane, swVirtComp)

                               

                                              ' Assigning the name sVirtPart - is the part that User pick from Listbox 'sVirtPart = PartNumber(lbox_VParts.SelectedIndex) 'Dim swVirtComp As SldWorks.Component2 defined somewhere else

                                              swVirtComp.Name2 = sVirtPart

                               

                                              Dim mDoc As ModelDoc2

                                              Dim custPropManager As CustomPropertyManager

                                              mDoc = swVirtComp.GetModelDoc2

                               

                                              ' adding and overwrting Custom properties

                                              custPropManager = mDoc.Extension.CustomPropertyManager("Default")

                                              custPropManager.Add3("Description", swCustomInfoType_e.swCustomInfoText, txt_NewPartDescr.Text, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue)

                                              custPropManager.Add3("Vendor", swCustomInfoType_e.swCustomInfoText, txt_Vendor.Text, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue)

                                              custPropManager.Add3("VendorNo", swCustomInfoType_e.swCustomInfoText, txt_VendorPN.Text, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue)

                               

                                              ' to be able to pattern the part we need to select it and select the axis

                                              boolstatus = swModel.Extension.SelectByID2(swVirtComp.Name2 & "@" & swModel.GetTitle, "COMPONENT", 0, 0, 0, False, 1, Nothing, 0)

                                              boolstatus = swModel.Extension.SelectByID2("X-Axis", "AXIS", 0, 0, 0, True, 2, Nothing, 0)

                               

                                             ' creating the pattern

                                              Dim FeatManager As FeatureManager

                                              FeatManager = swModel.FeatureManager

                                              FeatManager.FeatureLinearPattern(vp_qty, 1, 0, 0, False, False, "Qty", "")

                               

                                              ' this portion of the code Getting the lase Pattern Feature and Renaming it to Match last Added Virtual part name.

                                              Dim CurrentFeature As Feature

                                              Dim PreviousFeature As Feature

                                              CurrentFeature = swModel.FirstFeature

                               

                                              ' cycling through the features and getting the last one

                                              While Not CurrentFeature Is Nothing

                                                  PreviousFeature = CurrentFeature

                                                  CurrentFeature = CurrentFeature.GetNextFeature

                                              End While

                               

                                             ' renaming the pattern feature

                                              PreviousFeature.Name = sVirtPart + "-Pattern"

                                              mDoc.Save()

                               

                                          Catch ex As Exception

                                              swApp.SendMsgToUser("An exception occurred:" & vbCrLf & ex.Message)

                                          End Try

                                      End If