2 Replies Latest reply on Dec 31, 2016 8:23 AM by Yong Ning

    select Edge

    Yong Ning

      Edge.jpg

       

       

       

       

       

      Private Sub ll4()

         Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

             Set SwApp = Application.SldWorks

             Set SwModel = SwApp.ActiveDoc

         Dim SwDraw As DrawingDoc

             Set SwDraw = SwModel

         Dim SwView As View

             Set SwView = SwDraw.GetFirstView

             Set SwView = SwView.GetNextView

         Dim Pt(2) As Double

             'SwView.SetXform Pt

             SwDraw.ActivateView SwView.Name

         Dim oScale

             oScale = 1 / SwView.ScaleDecimal

             Debug.Print SwView.Name

         Dim SwSelMgr As SelectionMgr

             Set SwSelMgr = SwModel.SelectionManager

         Dim SwDispDim As DisplayDimension, SwDim As Dimension, Str

             Set SwDispDim = SwSelMgr.GetSelectedObject5(1)

             Set SwDim = SwDispDim.GetDimension

             Debug.Print SwDim.Value

            

         Dim SwAnn As Annotation, Params

             Set SwAnn = SwDispDim.GetAnnotation

             Params = SwAnn.GetPosition

             Xx = Params(0)

             Yy = Params(1) + SwDim.Value / 2000 / oScale

             tmp = SwModel.Extension.SelectByID2("", "EDGE", Xx, Yy, 0, True, 0, Nothing, 0)

             Yy = Params(1) - SwDim.Value / 2000 / oScale

             tmp = SwModel.Extension.SelectByID2("", "EDGE", Xx, Yy, 0, True, 0, Nothing, 0)

             Stop

             SwDraw.InsertCenterLine2

             Stop

      End Sub

        • Re: select Edge
          Yong Ning

          Traverse edge

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

          GetVisibleComponents+GetVisibleEntities

           

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

           

          Private Sub del20161221()

              Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

                  Set SwApp = Application.SldWorks

                  Set SwModel = SwApp.ActiveDoc

              Dim SwDraw As DrawingDoc

                  Set SwDraw = SwModel

              Dim SwSelMgr As SelectionMgr

                  Set SwSelMgr = SwModel.SelectionManager

              Dim SwView As View

                  Set SwView = SwSelMgr.GetSelectedObject5(1)

              Dim vComponts, vEdges

              Dim SwEdge As Edge, SwCurve As Curve, SwEnt As Entity

              'Dim swCurveParaData As SldWorks.CurveParamData

              Dim vLineParam, xx As Double, yy As Double, zz As Double

                  vComponts = SwView.GetVisibleComponents

                  For ii = 0 To UBound(vComponts)

                      vEdges = SwView.GetVisibleEntities(vComponts(ii), swViewEntityType_Edge)

                      For jj = 0 To UBound(vEdges)

                           Set SwEdge = vEdges(jj)

                           Set SwCurve = SwEdge.GetCurve

                           If SwCurve.IsLine Then

                               vLineParam = SwCurve.LineParams

                               ''

                               xx = vLineParam(0)

                               yy = vLineParam(1)

                               zz = vLineParam(2)

                               Debug.Print 0.225 = Abs(yy),

                               ''

                               Debug.Print ii, jj, xx, yy, zz

                               'If Val(Abs(yy)) = 0.225 Then

                               Debug.Print IsNumeric(Abs(yy)), VarType(yy), VarType(Abs(yy))

                               If Abs(yy) = 0.225 Then

                                 Set SwEnt = SwEdge

                                 SwEnt.Select True

                               End If

                           End If

                      Next jj

                  Next ii

                  ''

                  SwDraw.InsertCenterLine2

          End Sub

            • Re: select Edge
              Yong Ning

              ''

               

               

              Private Sub ll4()

                

                  Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

                      Set SwApp = Application.SldWorks

                      Set SwModel = SwApp.ActiveDoc

                  Dim SwDraw As DrawingDoc

                      Set SwDraw = SwModel

                  Dim SwView As View

                      Set SwView = SwDraw.GetFirstView

                      Set SwView = SwView.GetNextView

                  Dim SwDispDim As DisplayDimension, SwDim As Dimension

                

                  Dim SwAnn As Annotation, oScale

                  Dim Dnxy, Lxy, LnXy, HalfDn, ThkD

                  Dim DnAnn As Annotation, LnAnn As Annotation, LAnn As Annotation

                      oScale = 1 / SwView.ScaleDecimal

                      ''

                      Set SwDispDim = SwView.GetFirstDisplayDimension

                      Do While Not SwDispDim Is Nothing

                          Set SwDim = SwDispDim.GetDimension

                          Set SwAnn = SwDispDim.GetAnnotation

                          Select Case SwDim.Name

                             Case "Dn"

                                Dnxy = SwAnn.GetPosition

                                HalfDn = SwDim.Value / 2

                                Set DnAnn = SwAnn

                             Case "Ln"

                                LnXy = SwAnn.GetPosition

                                Set LnAnn = SwAnn

                             Case "L"

                                Lxy = SwAnn.GetPosition

                                Set LAnn = SwAnn

                             Case "THK"

                                ThkD = HalfDn + SwDim.Value

                          End Select

                          Set SwDispDim = SwDispDim.GetNext

                      Loop

                      ''Debug.Print (ThkD + 10) / 1000 / oScale

                      LnXy(1) = Dnxy(1) + (ThkD + 15 * oScale) / 1000 / oScale

                      Lxy(1) = LnXy(1) + 10 / 1000 '/ oScale

                      LnAnn.SetPosition LnXy(0), LnXy(1), 0

                      LAnn.SetPosition Lxy(0), Lxy(1), 0

                    

                      Stop

                    

                

              End Sub