AnsweredAssumed Answered

In Drawing ,Annotation.GetPosition result is Error

Question asked by Yong Ning on Feb 19, 2017
Latest reply on Feb 19, 2017 by Yong Ning

In Drawing,  follow code is error.

       Set SwAnn = SwNote.GetAnnotation

       Ss = SwAnn.GetPosition

Pt1.jpg

 

 

follow code result is error.

 

Private Sub ll3()

   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 SwNote As Note, SwAnn As Annotation

   Dim SwPt As SketchPoint, SwPt1 As SketchPoint

       Set SwNote = SwSelMgr.GetSelectedObject5(1)

       ''

       Set SwAnn = SwNote.GetAnnotation

       Ss = SwAnn.GetPosition

       Set SwPt = SwModel.CreatePoint2(Ss(0), Ss(1), 0)

       Debug.Print "Ss Coordinate is ", Ss(0), Ss(1)

       With SwPt

           Debug.Print "Pt Coordinate is ", .x, .y, .Z

       End With

       Stop

End Sub

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

Sub Del()

    Dim swApp As SldWorks.SldWorks, SwModel As ModelDoc2

    Dim SwMathUtil As MathUtility

    Dim SwSelMgr As SelectionMgr

    Dim SwSketch                As SldWorks.Sketch

    Dim swSketchLine            As SldWorks.SketchLine

    Dim swSkStartPt             As SldWorks.SketchPoint

    Dim swSkEndPt               As SldWorks.SketchPoint

    Dim nPt(2)                  As Double

    Dim vPt                     As Variant

    Dim swStartPt               As SldWorks.MathPoint

    Dim swEndPt                 As SldWorks.MathPoint

    Dim swEnt                   As SldWorks.Entity

    Dim swSkXform               As SldWorks.MathTransform

  

        Set swApp = Application.SldWorks

        Set SwMathUtil = swApp.GetMathUtility

        Set SwModel = swApp.ActiveDoc

        Set SwSelMgr = SwModel.SelectionManager

        Set swSketchLine = SwSelMgr.GetSelectedObject5(1)

        Set swSkStartPt = swSketchLine.GetStartPoint2

        Set swSkEndPt = swSketchLine.GetEndPoint2

        Set SwSketch = SwModel.GetActiveSketch

        Set swSkXform = SwSketch.ModelToSketchTransform

        Set swSkXform = swSkXform.Inverse

        nPt(0) = swSkStartPt.x

        nPt(1) = swSkStartPt.y

        nPt(2) = swSkStartPt.Z

        vPt = nPt

        Set swStartPt = SwMathUtil.CreatePoint(vPt)

        Set swStartPt = swStartPt.MultiplyTransform(swSkXform)

        nPt(0) = swSkEndPt.x

        nPt(1) = swSkEndPt.y

        nPt(2) = swSkEndPt.Z

        vPt = nPt

        Set swEndPt = SwMathUtil.CreatePoint(vPt)

        Set swEndPt = swEndPt.MultiplyTransform(swSkXform)

        Debug.Print "File = " & SwModel.GetPathName

        Debug.Print "    Start wrt sketch   = (" & swSkStartPt.x * 1000# & ", " & swSkStartPt.y * 1000# & ", " & swSkStartPt.Z * 1000# & ") mm"

        Debug.Print "    End   wrt sketch   = (" & swSkEndPt.x * 1000# & ", " & swSkEndPt.y * 1000# & ", " & swSkEndPt.Z * 1000# & ") mm"

        Debug.Print "    Start wrt model    = (" & swStartPt.ArrayData(0) * 1000# & ", " & swStartPt.ArrayData(1) * 1000# & ", " & swStartPt.ArrayData(2) * 1000# & ") mm"

        Debug.Print "    End   wrt model    = (" & swEndPt.ArrayData(0) * 1000# & ", " & swEndPt.ArrayData(1) * 1000# & ", " & swEndPt.ArrayData(2) * 1000# & ") mm"

End Sub

 

 

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

 

Private Sub del20170221()

    Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

        Set SwApp = Application.SldWorks

        Set SwModel = SwApp.ActiveDoc

    Dim SwMathUtil As MathUtility

        Set SwMathUtil = SwApp.GetMathUtility

    Dim SwSelMgr As SelectionMgr

        Set SwSelMgr = SwModel.SelectionManager

    Dim SwDispDim As DisplayDimension, SwAnn As Annotation

        Set SwDispDim = SwSelMgr.GetSelectedObject5(1)

        Set SwAnn = SwDispDim.GetAnnotation

    Dim vPos, vPt(2) As Double

        vPos = SwAnn.GetPosition

    Dim AttEnt, AttEntTypes

        AttEnt = SwAnn.GetAttachedEntities2

        AttEntTypes = SwAnn.GetAttachedEntityTypes

    Dim SwSketch As Sketch, SwSkXForm As MathTransform

        Set SwSketch = SwModel.GetActiveSketch

        Set SwSkXForm = SwSketch.ModelToSketchTransform

        Set SwSkXForm = SwSkXForm.Inverse

   

    Dim SkPt As SketchPoint, SkLine As SketchLine, SkSeg As SketchSegment

        Set SkPt = AttEnt(0)

    Dim SwPt As MathPoint, Pp(2)

        'Set SkPt = AttEnt(0)

        With SkPt

            Debug.Print .x, .y, .Z

            Debug.Print vPos(0), vPos(1), vPos(2)

            vPt(0) = .x

            vPt(1) = .y

        End With

        Set SwPt = SwMathUtil.CreatePoint(vPt)

        Set SwPt = SwPt.MultiplyTransform(SwSkXForm)

        With SwPt

            Debug.Print .ArrayData(0), .ArrayData(1), .ArrayData(2)

            'SwAnn.SetPosition .ArrayData(0), .ArrayData(1) + 0.008, .ArrayData(2)

            SwAnn.SetPosition .ArrayData(0), .ArrayData(1) - 0.025, .ArrayData(2)

        End With

        SwModel.ForceRebuild3 True

   

       

End Sub

Attachments

Outcomes