2 Replies Latest reply on Jul 20, 2017 8:42 PM by Prabaharan Pichaiyan

    Get perimeter of selected surface?

    Prabaharan Pichaiyan

      Hi,

      I need to get all faces perimeter of a selected feature. I found similar macro to find Area of a selected feature.

      But I don't know how to get Perimeter.

       

      ..... Find Area.....

       

      Sub Main()
      
          Dim swApp As SldWorks.SldWorks
          Dim swModel As SldWorks.ModelDoc2
          Dim swPart As SldWorks.PartDoc
          Dim swFeat As SldWorks.Feature
          Dim swFaceFeat As SldWorks.Feature
          Dim swSelMgr As SldWorks.SelectionMgr
          Dim swFace As SldWorks.Face2
          Dim swEnt As SldWorks.Entity
          Dim faceArr As Variant
          Dim oneFace As Variant
          Dim status As Boolean
          Dim Area As Double
          Dim TotalArea As Double
      
          'Initial Setup
          Set swApp = Application.SldWorks
          Set swModel = swApp.ActiveDoc
          Set swPart = swModel
          Set swSelMgr = swModel.SelectionManager
      
              Set swFeat = swSelMgr.GetSelectedObject6(1, -1)
              faceArr = swFeat.GetFaces: If IsEmpty(faceArr) Then Exit Sub
              For Each oneFace In faceArr
                  Set swFace = oneFace
                  Set swEnt = swFace
                  Set swFaceFeat = swFace.GetFeature
                 
              ' Check to see if face is owned by multiple features
                  If swFaceFeat Is swFeat Then
                      'status = swEnt.Select4(True, swSelData): Debug.Assert (status)
                    
              'Measures area of current face
                      Area = swFace.GetArea
      
       Debug.Print Area
                  End If
              
              Next
      
      
      
      End Sub
      

       

       

      Thanks.

        • Re: Get perimeter of selected surface?
          Ivana Kolin
          Option Explicit
          
          
          Sub Main()
          
              Dim swApp As SldWorks.SldWorks
              Dim swModel As SldWorks.ModelDoc2
              Dim swPart As SldWorks.PartDoc
              Dim swFeat As SldWorks.Feature
              Dim swFaceFeat As SldWorks.Feature
              Dim swSelMgr As SldWorks.SelectionMgr
              Dim swFace As SldWorks.Face2
              Dim swEnt As SldWorks.Entity
              Dim faceArr As Variant
              Dim oneFace As Variant
          
          
              Dim Area As Double
          
          
              Dim swMeasure As SldWorks.Measure
              Dim entities(0) As Entity
               
              'Initial Setup
              Set swApp = Application.SldWorks
              Set swModel = swApp.ActiveDoc
              Set swMeasure = swModel.Extension.CreateMeasure
              Set swPart = swModel
              Set swSelMgr = swModel.SelectionManager
            
              Set swFeat = swSelMgr.GetSelectedObject6(1, -1)
              faceArr = swFeat.GetFaces: If IsEmpty(faceArr) Then Exit Sub
              For Each oneFace In faceArr
                  Set swFace = oneFace
                  Set swEnt = swFace
                  Set swFaceFeat = swFace.GetFeature
                       
                  ' Check to see if face is owned by multiple features
                  If swFaceFeat Is swFeat Then
                      'status = swEnt.Select4(True, swSelData): Debug.Assert (status)
                          
                      'Measures area of current face
                      Area = swFace.GetArea
                      Set entities(0) = swFace
                      swMeasure.Calculate (entities)
                      Debug.Print "Area:" & Area & " " & "Perimeter:" & swMeasure.Perimeter
                  End If
                    
              Next
            
            
            
          End Sub