1 Reply Latest reply on Feb 20, 2017 4:21 AM by Yong Ning

    In Drawing ,Annotation.GetPosition result is Error

    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

        • Re: Annotation→Where is GetPosition
          Yong Ning

          In Part, follow code result is correct

          '******************************

                Set SwAnn = SwDispDim.GetAnnotation

                 Ss = SwAnn.GetPosition

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

          Result is correct.

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

          Private Sub ll2()

             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 SwDispDim  As DisplayDimension, SwAnn As Annotation

             Dim SwPt As SketchPoint, SwPt1 As SketchPoint

                 Set SwDispDim = SwSelMgr.GetSelectedObject5(1)

                 ''

                 Set SwAnn = SwDispDim.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

          Pt1_0.jpg

           

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

          ''

          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

           

           

          Pt1_1.jpg

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

          ''

          Private Sub ll3_1()

             Dim swApp As SldWorks.SldWorks, SwModel As ModelDoc2

             Dim SwMathUtil As MathUtility

                 Set swApp = Application.SldWorks

                 Set SwModel = swApp.ActiveDoc

                 Set SwMathUtil = swApp.GetMathUtility

             Dim SwDraw As DrawingDoc

                 'Set SwDraw = SwModel

             Dim SwSelMgr As SelectionMgr

                 Set SwSelMgr = SwModel.SelectionManager

             Dim SwDispDim  As DisplayDimension, SwAnn As Annotation

             Dim SwPt As MathPoint, SwPt1 As SketchPoint

             Dim SwSketch As Sketch, SwSkXForm As MathTransform

             Dim vPt(2), Ss

                  Set SwSketch = SwModel.GetActiveSketch

                  Set SwSkXForm = SwSketch.ModelToSketchTransform

                  'Set SwSkXForm = SwSkXForm.Inverse

                 Set SwDispDim = SwSelMgr.GetSelectedObject5(1)

                 ''

                 Set SwAnn = SwDispDim.GetAnnotation

                 Ss = SwAnn.GetPosition

                 Set SwPt = SwMathUtil.CreatePoint(Ss)

                 Set SwPt = SwPt.MultiplyTransform(SwSkXForm)

             

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

                 With SwPt

                     Debug.Print "Pt Coordinate is ", .ArrayData(0), .ArrayData(1), 0

                     SwModel.CreatePoint .ArrayData(0), .ArrayData(1), 0

                 End With

                 Stop

          End Sub

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

          Function RetuSwPt(SwModel As ModelDoc2, SwMathUtil As MathUtility, SwDispDim As DisplayDimension)

              Dim SwSketch As Sketch

              Dim SwSkXForm As MathTransform

              Dim SwAnn As Annotation

              Dim vPt, Ss, Pp(2)

            

              Dim Pt As MathPoint, SwPt(2) As MathPoint, sPt As SketchPoint

                  ''

                  Set SwSketch = SwModel.GetActiveSketch

                  Set SwSkXForm = SwSketch.ModelToSketchTransform

                  ''

                  Set SwAnn = SwDispDim.GetAnnotation

                  vPt = SwAnn.GetPosition

                  Set Pt = SwMathUtil.CreatePoint(vPt)

                  ''

                  Set Pt = Pt.MultiplyTransform(SwSkXForm)

                  Set SwPt(0) = Pt

                  ''

               Dim AttEntArr, AttEntTypeArr

                  AttEntArr = SwAnn.GetAttachedEntities

                  AttEntTypeArr = SwAnn.GetAttachedEntityTypes

                  Select Case AttEntTypeArr(0)

                     Case 10

                     Case 11

                        Set sPt = AttEntArr(0)

                        With sPt

                            Pp(0) = .x

                            Pp(1) = .y

                            Pp(2) = .Z

                        End With

                        Set Pt = SwMathUtil.CreatePoint(Pp)

                        Set Pt = Pt.MultiplyTransform(SwSkXForm)

                        Set SwPt(1) = Pt

                        ''

                        Set sPt = AttEntArr(1)

                        With sPt

                            Pp(0) = .x

                            Pp(1) = .y

                            Pp(2) = .Z

                        End With

                        Set Pt = SwMathUtil.CreatePoint(Pp)

                        Set Pt = Pt.MultiplyTransform(SwSkXForm)

                        Set SwPt(2) = Pt

                  End Select

                  ''

                  RetuSwPt = SwPt

                

          End Function

           

           

          ''

          Private Sub ll1()

             Dim swApp As SldWorks.SldWorks, SwModel As ModelDoc2

             Dim SwMathUtil As MathUtility

                 Set swApp = Application.SldWorks

                 Set SwModel = swApp.ActiveDoc

                 Set SwMathUtil = swApp.GetMathUtility

             Dim SwDraw As DrawingDoc

                 'Set SwDraw = SwModel

             Dim SwSelMgr As SelectionMgr

                 Set SwSelMgr = SwModel.SelectionManager

             Dim SwDispDim  As DisplayDimension, SwAnn As Annotation

             Dim SwPt As MathPoint, SwPt1 As SketchPoint

             Dim SwSketch As Sketch, SwSkXForm As MathTransform

             Dim vPt '(2), Ss

                

                  Set SwSketch = SwModel.GetActiveSketch

                  'Set SwSkXForm = SwSketch.ModelToSketchTransform

                  'Set SwSkXForm = SwSkXForm.Inverse

             Dim DimArr(), SwPtArr, Count As Integer

                 ''

                 For ii = 1 To 30

                     ''

                     Set SwDispDim = SwSelMgr.GetSelectedObject5(ii)

                     If Not SwDispDim Is Nothing Then

                         ReDim Preserve DimArr(Count)

                         Debug.Print SwDispDim.GetDimension.FullName

                         Set DimArr(Count) = SwDispDim

                         Count = Count + 1

                     End If

                 Next ii

                 ''

                 For ii = 0 To UBound(DimArr)

                     Set SwDispDim = DimArr(ii)

                     SwPtArr = RetuSwPt(SwModel, SwMathUtil, SwDispDim)

                     For jj = 0 To UBound(SwPtArr)

                          Set SwPt = SwPtArr(jj)

                          With SwPt

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

                              SwModel.CreatePoint .ArrayData(0), .ArrayData(1), 0

                          End With

                     Next jj

                 Next ii

          End Sub