5 Replies Latest reply on Jun 27, 2017 7:41 AM by Dave Bear

    How to move Arrow point of Note (balloon)?

    Yong Ning

      00.jpg

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

      follow code, can be move annotion position,

      but don't move arrow point

       

      Help me , arrow point of balloon ?

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

      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 SwAnn As Annotation

        

         Dim SwNote As INote, TxtFormat As TextFormat

            Set SwNote = SwSelMgr.GetSelectedObject5(1)

            With SwNote

               Debug.Print .GetName

               .SetBalloon 1, 0

               ss = .GetArrowHeadInfo

               ss = .GetAttachPos

               Set SwAnn = .GetAnnotation

               With SwAnn

                   ss = .GetPosition

                   '.SetPosition 0.052, 0.165 + 0.03, 0

                   .SetLeader3 1, 3, False, False, False, False

                   .SetPosition 0.052, 0.165 - 0.015, 0

                   ss = .GetLeaderPointsAtIndex(0)

                   For jj = 0 To UBound(ss)

                      Debug.Print Round(ss(jj) * 1000, 2)

                   Next jj

                   .SetArrowHeadStyleAtIndex 1, 3

               End With

               Set TxtFormat = .GetTextFormat

               With TxtFormat

                  .CharHeight = 2.5 / 1000

          

               End With

               ss = .GetArrowHeadAtIndex(1)

           

            End With

      End Sub

       

       

      2010 SOLIDWORKS API Help - Attach Annotation to Entity Example (VBA)

      http://help.solidworks.com/2010/english/api/sldworksapi/Attach_Annotation_to_Entity_Example_VB.htm

        • Re: How to move Arrow point of Note (balloon)?
          Yong Ning

          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 SwVertex As IVertex, Ppp

           

                Set SwVertex = swSelMgr.GetSelectedObject5(1)

                Ppp = SwVertex.GetPoint

                'Stop

                ''

              

                ''

             Dim SwMathUtil As MathUtility

                Set SwMathUtil = swApp.GetMathUtility

             Dim SwMathPt As IMathPoint

                Set SwMathPt = SwMathUtil.CreatePoint(Ppp)

             Dim SwDraw As DrawingDoc, SwView As View

                Set SwDraw = swApp.ActivateDoc("a.SldDrw")

             Dim swNote As INote, oScale

                ''

                Set SwView = SwDraw.GetFirstView

                Set SwView = SwView.GetNextView

                ''

                oScale = 1 / SwView.ScaleDecimal

                ''

             Dim SwViewXForm As IMathTransform, xx, yy

                Set SwViewXForm = SwView.ModelToViewTransform

             Dim SwViewPt As IMathPoint

                Set SwViewPt = SwMathPt.MultiplyTransform(SwViewXForm)

           

                  tmp = SwView.SelectEntity(SwVertex, False)

                With SwViewPt

                  xx = .ArrayData(0) * oScale

                  yy = .ArrayData(1) * oScale

                  zz = .ArrayData(2) * oScale

                  Debug.Print xx * 1000, yy * 1000, zz * 1000

                End With

                ''

                tmp = SwDraw.Extension.SelectByID2("", "SILHOUETTE", xx, yy, zz, False, 0, Nothing, 0)

                ''

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

                'Stop

          End Sub

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

          Private Sub ll1()

             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 IVertex,Pp

             Dim SwPt As SketchPoint, Pp(2)

           

           

                Set SwPt = swSelMgr.GetSelectedObject5(1)

                With SwPt

                   Pp(0) = .X

                   Pp(1) = .Y

                   Pp(2) = .Z

                   Stop

                End With

              

                ''

             Dim SwMathUtil As MathUtility

                Set SwMathUtil = swApp.GetMathUtility

             Dim SwMathPt As IMathPoint

                Set SwMathPt = SwMathUtil.CreatePoint(Pp)

             Dim SwDraw As DrawingDoc, SwView As View

                Set SwDraw = swApp.ActivateDoc("a.SldDrw")

             Dim swNote As INote, oScale

                ''

                Set SwView = SwDraw.GetFirstView

                Set SwView = SwView.GetNextView

                ''

                oScale = 1 / SwView.ScaleDecimal

                ''

             Dim SwViewXForm As IMathTransform, xx, yy

                Set SwViewXForm = SwView.ModelToViewTransform

             Dim SwViewPt As IMathPoint

                Set SwViewPt = SwMathPt.MultiplyTransform(SwViewXForm)

           

                  tmp = SwView.SelectEntity(SwPt, False)

                With SwViewPt

                  xx = .ArrayData(0) * oScale

                  yy = .ArrayData(1) * oScale

                  zz = .ArrayData(2) * oScale

                  Debug.Print xx * 1000, yy * 1000, zz * 1000

                End With

                ''

                tmp = SwDraw.Extension.SelectByID2("", "SILHOUETTE", xx, yy, zz, False, 0, Nothing, 0)

                ''

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

                'Stop

          End Sub

          • Re: How to move Arrow point of Note (balloon)?
            Yong Ning

            Don't  move Arrow point of Note.

             

             

             

            Function GetOrientation(swDisplayDimension As DisplayDimension) As String

                Dim SwDim As SldWorks.Dimension

                Set SwDim = swDisplayDimension.GetDimension '2(0)

                Dim swMathVec As SldWorks.MathVector

                Dim vDir As Variant

             

                GetOrientation = ""

             

                Set swMathVec = SwDim.DimensionLineDirection

                vDir = swMathVec.ArrayData

             

                If IsCollinear(vDir(0), 1) And IsCollinear(vDir(1), 0) Then

                    GetOrientation = "HOR"

                ElseIf IsCollinear(vDir(1), 1) And IsCollinear(vDir(0), 0) Then

                    GetOrientation = "VER"

                End If

            End Function

             

            Function IsCollinear(val As Variant, vector As Double) As Boolean

                Const TOL = 0.00000001

                IsCollinear = Abs(Abs(val) - Abs(vector)) < TOL

            End Function

            Function RefPtArr(SwModel As ModelDoc2, SwMathUtil As MathUtility, SwView As View, SwDispDim As DisplayDimension)

               Dim SwXForm As MathTransform

                   Set SwXForm = SwView.ModelToViewTransform

               Dim SwDim As Dimension, SwAnn As Annotation

               Dim Ss, oScale, ii, Str

               Dim MathPt As MathPoint

               Dim SwNote As Note

                   With SwDispDim

                       Set SwDim = .GetDimension

                       'Debug.Print SwDim.FullName

                       Set SwAnn = .GetAnnotation

                       Ss = SwDim.ReferencePoints

                       oScale = 1

                       For ii = 0 To 2

                           Set MathPt = Ss(ii)

                           Set MathPt = MathPt.MultiplyTransform(SwXForm)

                           With MathPt

                                    Debug.Print "   xy(" & ii & "," & 0 & ")=" & Round(.ArrayData(0), 6) & ":",

                                    Debug.Print "   xy(" & ii & "," & 1 & ")=" & Round(.ArrayData(1), 6)

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

                                    Str = GetOrientation(SwDispDim) & "-" & SwDim.Name & "-" & ii & " (" & Round(.ArrayData(0), 4) & "," & Round(.ArrayData(1), 4) & ",0)"

                                    Set SwNote = SwModel.InsertNote(Str)

                                    Set SwAnn = SwNote.GetAnnotation

                           End With

                       Next ii

                   End With

                   Ss = SwDim.ReferencePoints

            End Function

            Private Sub del20170625()

                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 SwDraw As DrawingDoc

                     Set SwDraw = SwModel

                Dim SwView As View

                     Set SwView = SwDraw.GetFirstView

                Dim SkSketch As Sketch, SkPtArr

                     Set SkSketch = SwView.GetSketch

                     SkPtArr = SkSketch.GetSketchPoints

                     ''

                     If Not IsEmpty(SkPtArr) Then

                        For ii = 0 To UBound(SkPtArr)

                            Set SkPt = SkPtArr(ii)

                            SkPt.Select True

                        Next ii

                        SwModel.EditDelete

                     End If

                     ''

                Dim SwDispDim As DisplayDimension

              

                Dim SwNote As Note, SwAnn As Annotation, Anns

                   

                     Set SwView = SwView.GetNextView

                ''

                     Do While Not SwView Is Nothing

                         SwModel.ClearSelection2 True

                         Set SwNote = SwView.GetFirstNote

                         Do While Not SwNote Is Nothing

                            'Debug.Print SwNote.GetText

                            Set SwAnn = SwNote.GetAnnotation

                            SwAnn.Select True

                          

                            Set SwNote = SwNote.GetNext

                         Loop

                         ''

                         SwModel.EditDelete

                         SwModel.ClearSelection2 True

                         ''

                         Set SwDispDim = SwView.GetFirstDisplayDimension

                         Do While Not SwDispDim Is Nothing

                              With SwDispDim

                                   If .Type2 = 2 Or .Type2 = 11 Or .Type2 = 12 Then

                                       Debug.Print "'******** Êý×é" & SwDispDim.GetDimension.Name

                                       Arr = RefPtArr(SwModel, SwMathUtil, SwView, SwDispDim)

                                   End If

                              End With

                              Set SwDispDim = SwDispDim.GetNext

                         Loop

                         Set SwView = SwView.GetNextView

                     Loop

            End Sub

            • Re: How to move Arrow point of Note (balloon)?
              Dave Bear

              Hi Yong,

              Why do you keep 'bumping' this thread up the list?

               

              Dave.