AnsweredAssumed Answered

How to travese the point in view?

Question asked by Yong Ning on May 9, 2015

This point in  a.sldasm→a.sldprt→sketch1→point1

 

→ Point1@Sketch1@a-1@Drawing View1/Part1-3@a

 

 

 

 

00.jpg

record macro code is

 

boolstatus = Part.Extension.SelectByID2("Point1@Sketch1@a-1@Drawing View1/Part1-3@a", "EXTSKETCHPOINT", -0.035, -0.018, 0, False, 0, Nothing, 0)

 

Help me

How to traverse the point in view →  For example Fig. select point.

my method is

 

Private Sub ll3()

   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 SwDraw As DrawingDoc, SwView As View

      Set SwDraw = SwModel

      Set SwView = SwSelMgr.GetSelectedObject5(1)

      'Debug.Print SwView.GetName2

    

   Dim SwAssy As AssemblyDoc, oSwModel As ModelDoc2

    

      Set SwAssy = SwView.ReferencedDocument

      Debug.Print SwAssy.GetTitle,

      'Stop

   Dim vComp, SwComp As IComponent2

      vComp = SwAssy.GetComponents(True)

      'Set SwComp = vComp(2)

      'Stop

      'Set SwComp = vComp(0)

      'Stop

      Set oSwModel = vComp(0).GetModelDoc

      Debug.Print oSwModel.GetTitle

      'Stop

    

   Dim SwFeat As IFeature

      'Set SwFeat = SwDraw.FeatureByName("Sketch1@a@Drawing View1/Part1@a")

      Set SwFeat = oSwModel.FeatureByName("Sketch1")

      SwFeat.Select True

      'Stop

   Dim SwSketch As Sketch, SwPt As ISketchPoint, vPt, Pt As ISketchPoint

      Set SwSketch = SwFeat.GetSpecificFeature

      vPt = SwSketch.GetSketchPoints

      For ii = 0 To UBound(vPt)

         Set SwPt = vPt(ii)

         If SwPt.Type = 1 Then

            Set Pt = SwDraw.CreatePoint2(SwPt.X, SwPt.Y, 0)

            Stop

         End If

      Next ii

      Stop

End Sub

 

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

Private Sub ll4()

   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 SwPt As ISketchPoint, PtArr(2) As Double

      Set SwPt = SwSelMgr.GetSelectedObject5(1)

      With SwPt

         PtArr(0) = .X

         PtArr(1) = .Y

      End With

      ''

   Dim SwMathUtil As MathUtility

      Set SwMathUtil = SwApp.GetMathUtility

   Dim SwMathPt As IMathPoint

      Set SwMathPt = SwMathUtil.CreatePoint(PtArr)

     

   Dim SwDraw As DrawingDoc, SwView As View

      Set SwDraw = SwApp.ActivateDoc("t.SldDrw")

      Debug.Print SwDraw.GetPathName

      ''

      Set SwView = SwDraw.GetFirstView

      Set SwView = SwView.GetNextView

   Dim SwViewXForm As IMathTransform

      Set SwViewXForm = SwView.ModelToViewTransform

   Dim SwViewPt As IMathPoint

      Set SwViewPt = SwMathPt.MultiplyTransform(SwViewXForm)

   Dim tmp, SwNote As INote

     

      With SwViewPt

        'Set Pt = SwDraw.CreatePoint2(.ArrayData(0), .ArrayData(1), 0)

        tmp = SwModel.Extension.SelectByID2("", "FACE", .ArrayData(0), .ArrayData(1), 0, False, 0, Nothing, 0)

        Set SwNote = SwDraw.InsertStackedBalloon(1, 1, 1, "", 0, "")

        xx = .ArrayData(0) * 1000

        yy = .ArrayData(1) * 1000

      End With

      Stop

 

 

End Sub

Attachments

Outcomes