AnsweredAssumed Answered

How to pattern Virtual parts?

Question asked by Sanya Shmidt on Sep 30, 2014
Latest reply on Nov 20, 2014 by Sanya Shmidt

Like • Show 0 Likes0
Comment • 6

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.

Sanya Shmidt Nov 20, 2014 9:00 AM

Correct Answer

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

See the reply in context

No one else had this question

Outcomes

Deepak Gupta Oct 1, 2014 3:34 AM

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

Actions

Sanya Shmidt @ Deepak Gupta on Oct 1, 2014 11:11 PM

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.

Actions

Deepak Gupta @ Sanya Shmidt on Oct 2, 2014 1:02 AM

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

Actions

Sanya Shmidt @ Deepak Gupta on Oct 2, 2014 8:29 PM

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.

Actions

Deepak Gupta @ Sanya Shmidt on Oct 3, 2014 1:36 PM

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

Actions

Sanya Shmidt @ Deepak Gupta on Nov 20, 2014 9:00 AM

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

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

Actions

6 Replies

Deepak Gupta Oct 1, 2014 3:34 AM
Mark Correct
Correct Answer
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
Like • Show 0 Likes0
Actions
- Sanya Shmidt @ Deepak Gupta on Oct 1, 2014 11:11 PM
  Mark Correct
  Correct Answer
  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.
  Like • Show 0 Likes0
  Actions
  - Deepak Gupta @ Sanya Shmidt on Oct 2, 2014 1:02 AM
    Mark Correct
    Correct Answer
    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
    Like • Show 1 Like1
    Actions
    - Sanya Shmidt @ Deepak Gupta on Oct 2, 2014 8:29 PM
      Mark Correct
      Correct Answer
      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.
      Like • Show 0 Likes0
      Actions
      - Deepak Gupta @ Sanya Shmidt on Oct 3, 2014 1:36 PM
        Mark Correct
        Correct Answer
        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
        Like • Show 0 Likes0
        Actions
        Sanya Shmidt @ Deepak Gupta on Nov 20, 2014 9:00 AM
        Unmark Correct
        Correct Answer
        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
        Like • Show 0 Likes0
        Actions

How to pattern Virtual parts?

Outcomes

Related Content

Recommended Content

Incoming Links