8 Replies Latest reply on Jul 21, 2017 1:46 AM by Prabaharan Pichaiyan

    Skip pattern instances to skip component in looping?

    Prabaharan Pichaiyan

      I got a macro to create a layers in assembly drawing by the name value of custom properties.

      I'm facing some error while processing pattern components in assembly. If I have any skipped components in pattern, there its getting an error.

      Could you please suggest some codes to skip those components?

       

      Here are those codes,

       

      Option Explicit
      Sub main()
          Dim swApp       As SldWorks.SldWorks
          Dim swModel     As SldWorks.ModelDoc2
          Dim swDraw      As SldWorks.DrawingDoc
          Dim swSelMgr    As SldWorks.SelectionMgr
          Dim swView      As SldWorks.View
          Dim swDrawComp  As SldWorks.DrawingComponent
            
          Set swApp = Application.SldWorks
          Set swModel = swApp.ActiveDoc
          Set swDraw = swModel
          Set swSelMgr = swModel.SelectionManager
          Set swView = swSelMgr.GetSelectedObject6(1, -1)
          Set swDrawComp = swView.RootDrawingComponent
          ProcessDrawingComponent swApp, swDraw, swDrawComp, ""
      End Sub
        
      Sub ProcessDrawingComponent(swApp As SldWorks.SldWorks, swDraw As SldWorks.DrawingDoc, swDrawComp As SldWorks.DrawingComponent, sPadStr As String)
          Dim vDrawCompChildArr   As Variant
          Dim vDrawCompChild      As Variant
          Dim swDrawCompChild     As SldWorks.DrawingComponent
          
          Dim swComp As SldWorks.Component2
          Dim swCompModel As SldWorks.ModelDoc2
          Dim swCustProp As CustomPropertyManager
          Dim val As String
          Dim valout As String
          Dim chkresult As Integer
        
      Set swComp = swDrawComp.Component
      Set swCompModel = swComp.GetModelDoc2
      
      
      If swComp.GetSuppression <> 0 Then
      Debug.Print "      Component                            = " & swComp.Name2
      If swCompModel.GetType = 1 Then
      
      
      Set swCustProp = swCompModel.Extension.CustomPropertyManager("")
      swCustProp.Get4 "Description", False, val, valout 'Change property name here
      If InStr(valout, "Test") = 1 Then
      
      
      ChangeComponentLayer swApp, swDraw, swDrawComp, UCase(valout),
          vDrawCompChildArr = swDrawComp.GetChildren
          If Not IsEmpty(vDrawCompChildArr) Then
              For Each vDrawCompChild In vDrawCompChildArr
                  Set swDrawCompChild = vDrawCompChild
                       ProcessDrawingComponent swApp, swDraw, swDrawCompChild, sPadStr + "  "
              Next
          End If
       End Sub
        
      Private Sub ChangeComponentLayer(swApp As SldWorks.SldWorks, swDraw As SldWorks.DrawingDoc, swDrawComp As SldWorks.DrawingComponent, sLayerName As String)
          Dim bRet As Boolean
          bRet = swDraw.CreateLayer(sLayerName, sLayerName, 0, swLineCONTINUOUS, swLW_NORMAL, True): Debug.Assert bRet
          swDrawComp.Layer = sLayerName
      End Sub
      

       

       

      Thank you

        • Re: Skip pattern instances to skip component in looping?
          Nilesh Patel

          Hi Prabaharan,

           

          Are these working codes? You have four 'IF' statements in your sub 'ProcessDrawingComponent' but only one 'END IF'. Your macro won't even compile. Can you post full codes, if you would like someone to help you.

           

          Another thing I would like to point out is that you have an IF condition 'If swCompModel.GetType = 1 Then' in your sub 'ProcessDrawingComponent'. 1 = swDocPART. So if the component model is an assembly document in the drawing view, codes inside this if condition will never execute including 'ChangeComponentLayer' and components layers will never be set.

           

          Looking at your code, I guess you are trying to set layers of all components of an assembly document in the drawing view based on the value of the customer property of each component. If it is the case, get all components of the assembly document using IAssemblyDoc.GetComponents(false) and then run the loop through each component to set the layer. You also need to check if the layer already exist or not. If yes, you don't need to create one.

           

          Let me know, if you need some help.

           

          Regards,

            • Re: Skip pattern instances to skip component in looping?
              Prabaharan Pichaiyan

              Apologize,

              I wrongly post my draft copy of that codes.

              Here are those codes. I tested this and its working fine.

               

              Option Explicit
              Sub main()
                  Dim swApp       As SldWorks.SldWorks
                  Dim swModel     As SldWorks.ModelDoc2
                  Dim swDraw      As SldWorks.DrawingDoc
                  Dim swSelMgr    As SldWorks.SelectionMgr
                  Dim swView      As SldWorks.View
                  Dim swDrawComp  As SldWorks.DrawingComponent
                    
                  Set swApp = Application.SldWorks
                  Set swModel = swApp.ActiveDoc
                  Set swDraw = swModel
                  Set swSelMgr = swModel.SelectionManager
                  Set swView = swSelMgr.GetSelectedObject6(1, -1)
                  Set swDrawComp = swView.RootDrawingComponent
                  ProcessDrawingComponent swApp, swDraw, swDrawComp, ""
              End Sub
                
              Sub ProcessDrawingComponent(swApp As SldWorks.SldWorks, swDraw As SldWorks.DrawingDoc, swDrawComp As SldWorks.DrawingComponent, sPadStr As String)
                  Dim vDrawCompChildArr   As Variant
                  Dim vDrawCompChild      As Variant
                  Dim swDrawCompChild     As SldWorks.DrawingComponent
                  
                  Dim swComp As SldWorks.Component2
                  Dim swCompModel As SldWorks.ModelDoc2
                  Dim swCustProp As CustomPropertyManager
                  Dim val As String
                  Dim valout As String
                  Dim chkresult As Integer
                
              Set swComp = swDrawComp.Component
              Set swCompModel = swComp.GetModelDoc2
              
              
              If swComp.GetSuppression <> 0 Then
              Debug.Print "      Component                            = " & swComp.Name2
              If swCompModel.GetType = 1 Then
              
              
              Set swCustProp = swCompModel.Extension.CustomPropertyManager("")
              swCustProp.Get4 "Description", False, val, valout 'Change property name here
              End If
              End If
              ChangeComponentLayer swApp, swDraw, swDrawComp, UCase(valout), UCase(val)
                    
                  vDrawCompChildArr = swDrawComp.GetChildren
                  If Not IsEmpty(vDrawCompChildArr) Then
                      For Each vDrawCompChild In vDrawCompChildArr
                          Set swDrawCompChild = vDrawCompChild
                               ProcessDrawingComponent swApp, swDraw, swDrawCompChild, sPadStr + "  "
                      Next
                  End If
               End Sub
                
              Private Sub ChangeComponentLayer(swApp As SldWorks.SldWorks, swDraw As SldWorks.DrawingDoc, swDrawComp As SldWorks.DrawingComponent, sLayerName As String, sLayerdesc As String)
                  Dim bRet As Boolean
                  bRet = swDraw.CreateLayer(sLayerName, sLayerdesc, 0, swLineCONTINUOUS, swLW_NORMAL, True): Debug.Assert bRet
                  swDrawComp.Layer = sLayerName
              End Sub
              
              

               

               

              Thanks