1 Reply Latest reply on Jan 13, 2016 10:10 AM by Yong Ning

    how to get the cut hole coordinate with fill patterns?

    Yong Ning

      7.jpg

       

       

       

      Private Sub ll()

         Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

            Set SwApp = Application.SldWorks

            Set SwModel = SwApp.ActiveDoc

         Dim SwSelMgr As SelectionMgr

            Set SwSelMgr = SwModel.SelectionManager

         Dim SwFeat As Feature

            Set SwFeat = SwSelMgr.GetSelectedObject5(1)

         Dim fCount

            fCount = SwFeat.GetFaceCount

            For ii = 1 To fCount

             

            Next ii

      End Sub

       

      the code result → count the cut hole.

       

      9.jpg

       

       

       

      Help me

       

      How to get the coordinate  with fill pattern.

        • Re: how to get the cut hole coordinate with fill patterns?
          Yong Ning

          Follow code, have get  edge.→ Set SwEdge = vEdge(0)

          8.jpg

           

           

          **********************************

           

          Private Sub ll()

             Dim Xls As Excel.Application, Rng As Range

                Set Xls = GetObject(, "Excel.Application")

                Set Rng = Xls.Cells(1, 1)

             Dim yDict As New Dictionary, xx(), yy(), oArr

             Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

                Set SwApp = Application.SldWorks

                Set SwModel = SwApp.ActiveDoc

             Dim SwSelMgr As SelectionMgr

                Set SwSelMgr = SwModel.SelectionManager

             Dim SwFeat As Feature, Total As Integer

                Set SwFeat = SwSelMgr.GetSelectedObject5(1)

             Dim fCount, vFace, SwFace As Face2

             Dim SwEdgePt, SwEdge As Edge, vEdge

             Dim SwSketch As Sketch, SwCurve As Curve

                ''

                vFace = SwFeat.GetFaces

                fCount = SwFeat.GetFaceCount

                ReDim xx(fCount), yy(fCount)

                For ii = 0 To UBound(vFace)

                   Set SwFace = vFace(ii)

                   With SwFace

                      vEdge = .GetEdges

                      Set SwEdge = vEdge(0)

                    

                      With SwEdge

                          Set SwCurve = .GetCurve

                          ss = SwCurve.CircleParams

                          xx(ii) = Round(ss(0) * 1000, 2)

                          yy(ii) = Round(ss(2) * 1000, 1)

                          yDict(yy(ii)) = ""

                      End With

                   End With

                Next ii

                oArr = Bubble_Sort(yDict.Keys, "ASC")

             Dim yCount()

             ReDim yCount(UBound(oArr), 1)

                For ii = 0 To UBound(oArr)

                    'Debug.Print Xls.WorksheetFunction.CountIf(yy, oArr(ii))

                    cc = 0

                    For jj = 0 To UBound(yy)

                       If oArr(ii) = yy(jj) Then

                          cc = cc + 1

                       End If

                    Next jj

                    yCount(ii, 0) = oArr(ii)

                    yCount(ii, 1) = cc

                    Total = Total + cc

                Next ii

                Debug.Print Total

                Stop

          End Sub

           

          ''

           

          ''

          ''

          Function Bubble_Sort(Ary, objOrder As String)

             Dim aryUBound, i, j

             aryUBound = UBound(Ary)

             For ii = 0 To aryUBound

               Ary(ii) = Val(Round(Ary(ii), 2))

             Next ii

             For i = 0 To aryUBound

               For j = i + 1 To aryUBound

                 Select Case UCase(objOrder)

                   Case "DESC"

                     If Ary(i) < Ary(j) Then

                       Swap Ary(i), Ary(j)

                     End If

                   Case "ASC"

                     If Ary(i) > Ary(j) Then

                       Swap Ary(i), Ary(j)

                     End If

                 End Select

               Next

             Next

             Bubble_Sort = Ary

          End Function

          ''

          Function Swap(a, B)

             Dim tmp

             tmp = a

             a = B

             B = tmp

          End Function