2 Replies Latest reply on Aug 6, 2017 10:01 AM by Yong Ning

    SwDim.ReferencePoints+MathPoint

    Yong Ning

      Follow code, result is Error.

       

      Help me .

      How to use MathPoint and ReferencePoints?

       

      ReferencePoints2.jpg

       

      ReferencePoints1.jpg

       

       

       

       

      Private Sub ll()

         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, SwDim As Dimension

             Set SwDispDim = SwSelMgr.GetSelectedObject5(1)

             Set SwDim = SwDispDim.GetDimension

             ss = SwDim.ReferencePoints

         Dim SwPt As MathPoint, SwPt1 As MathPoint, SwPt2 As MathPoint

             Set SwPt = ss(0)

             Set SwPt1 = ss(1)

             Set SwPt2 = ss(2)

         Dim Xx, Yy, Xx1, Yy1, Xx2, Yy2

             ''

             Xx = SwPt.ArrayData(0)

             Yy = SwPt.ArrayData(1)

             ''

             Xx1 = SwPt1.ArrayData(0)

             Yy1 = SwPt1.ArrayData(1)

             ''

             Xx2 = SwPt2.ArrayData(0)

             Yy2 = SwPt2.ArrayData(1)

             Debug.Print Xx * 1000, Yy * 1000

             Debug.Print Xx1 * 1000, Yy1 * 1000

             Debug.Print Xx2 * 1000, Yy2 * 1000

             SwModel.CreateLine2 Xx1, Yy1, 0, Xx2, Yy2, 0

             SwModel.CreateLine2 Xx, Yy, 0, Xx2, Yy2, 0

             SwModel.CreateLine2 Xx1, Yy1, 0, Xx, Yy, 0

      End Sub

        • Re: SwDim.ReferencePoints+MathPoint
          Yong Ning

          Need skill

          ModelToViewTransform

          ModelToViewTransform

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

          SketchPoint Coordinates to Model Coodinates | SOLIDWORKS Forums  https://forum.solidworks.com/message/691470

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

           

           

          Dimension Edge in Drawing Example (VB)

          This examples shows how to dimension an edge in a drawing view.

           

          '----------------------------------------------

          '

          ' Problem:

          '       This example shows how to automatically add a

          '       dimension to a straight edge in all drawing views

          '       in which it appears. The edge geometry is transformed

          '       to the space of each drawing view and, depending on

          '       whether it is horizontal or vertical, an appropriate

          '       style of dimension is added.

          '

          '       This example could form the basis for an application

          '       to automatically dimension a model when it is added to

          '       a drawing.

          '

          ' Preconditions:

          '       (1) Part or assembly is open.

          '       (2) If an assembly, it is fully resolved.

          '       (3) A straight edge is selected in the SolidWorks graphics area.

          '

          ' Postconditions:

          '       (1) New drawing is created with three views.

          '       (2) If possible, the previously selected edge

          '          is dimensioned in all drawing views.

          '

          ' NOTE:  The dimension is not created if

          '        the edge cannot be converted in a drawing view.

          '

          '----------------------------------------------

          Option Explicit

          Public Const LINE_TYPE              As Integer = 3001

          Public Const CIRCLE_TYPE            As Integer = 3002

          Public Const ELLIPSE_TYPE           As Integer = 3003

          Public Const INTERSECTION_TYPE      As Integer = 3004

          Public Const BCURVE_TYPE            As Integer = 3005

          Public Const SPCURVE_TYPE           As Integer = 3006

          Public Const CONSTPARAM_TYPE        As Integer = 3008

          Public Const TRIMMED_TYPE           As Integer = 3009

           

          ' Define two types

          Type DoubleRec

              dValue As Double

          End Type

          Type Long2Rec

              iLower As Long

              iUpper As Long

          End Type

           

          ' Extract two integer values out of a single double value,

          ' by assigning a DoubleRec to the double value and

          ' copying the value over an Long2Rec and

          ' extracting the integer values.

          Function ExtractFields _

          ( _

              ByVal dValue As Double, _

              iLower As Long, _

              iUpper As Long _

          )

              Dim dr                          As DoubleRec

              Dim i2r                         As Long2Rec

              ' Set the double value

              dr.dValue = dValue

              ' Copy the values

              LSet i2r = dr

              ' Extract the values

              iLower = i2r.iLower

              iUpper = i2r.iUpper

          End Function

           

          Sub main()

           

              Const sPathToTemplate           As String = "c:\Program Files\SolidWorks\data\templates\drawing.drtdot"

             

              Const nTolerance                As Double = 0.00000001

             

              Const nXoffset                  As Double = 0.01

              Const nYoffset                  As Double = 0.01

             

              Dim swApp                       As SldWorks.SldWorks

              Dim swModel                     As SldWorks.ModelDoc2

              Dim swSelMgr                    As SldWorks.SelectionMgr

              Dim swEdge                      As SldWorks.Edge

              Dim swEnt                       As SldWorks.entity

              Dim swCurve                     As SldWorks.Curve

              Dim vCurveParam                 As Variant

              Dim nDummy                      As Long

              Dim nIdentity                   As Long

              Dim nTag                        As Long

              Dim nSense                      As Long

             

              Dim swMathUtil                  As SldWorks.MathUtility

              Dim nPtData(2)                  As Double

              Dim vPtData                     As Variant

              Dim swModelStartPt              As SldWorks.MathPoint

              Dim swModelEndPt                As SldWorks.MathPoint

              Dim swViewStartPt               As SldWorks.MathPoint

              Dim swViewEndPt                 As SldWorks.MathPoint

             

              Dim swDraw                      As SldWorks.DrawingDoc

              Dim swDrawModel                 As SldWorks.ModelDoc2

              Dim swView                      As SldWorks.view

              Dim swViewXform                 As SldWorks.MathTransform

              Dim vOutline                    As Variant

              Dim swDispDim                   As SldWorks.DisplayDimension

             

              Dim nXpos                       As Double

              Dim nYpos                       As Double

              Dim bRet                        As Boolean

              Set swApp = CreateObject("SldWorks.Application")

              Set swModel = swApp.ActiveDoc

              Set swSelMgr = swModel.SelectionManager

              Set swEdge = swSelMgr.GetSelectedObject5(1)

              Set swCurve = swEdge.GetCurve

              Set swEnt = swEdge

             

              vCurveParam = swEdge.GetCurveParams2

              ExtractFields vCurveParam(8), nDummy, nIdentity

              ExtractFields vCurveParam(9), nDummy, nTag

              ExtractFields vCurveParam(10), nDummy, nSense

             

              Debug.Print "Start      = (" & vCurveParam(0) * 1000# & ", " & vCurveParam(1) * 1000# & ", " & vCurveParam(2) * 1000# & ") mm "

              Debug.Print "End        = (" & vCurveParam(3) * 1000# & ", " & vCurveParam(4) * 1000# & ", " & vCurveParam(5) * 1000# & ") mm "

              Debug.Print "Uparam     = [" & vCurveParam(6) & ", " & vCurveParam(7) & "]"

              Debug.Print "Identity   = " & nIdentity

              Debug.Print "Tag        = " & nTag

              Debug.Print "Sense      = " & nSense

             

              ' Derived quantity

              Debug.Print "Length     = " & swCurve.GetLength2(vCurveParam(6), vCurveParam(7)) * 1000# & " mm "

              Debug.Print ""

             

              ' Only makes sense for straight edges

              If LINE_TYPE <> nIdentity Then Exit Sub

             

              Set swMathUtil = swApp.GetMathUtility

             

              nPtData(0) = vCurveParam(0)

              nPtData(1) = vCurveParam(1)

              nPtData(2) = vCurveParam(2)

              vPtData = nPtData

              Set swModelStartPt = swMathUtil.CreatePoint(vPtData)

             

              nPtData(0) = vCurveParam(3)

              nPtData(1) = vCurveParam(4)

              nPtData(2) = vCurveParam(5)

              vPtData = nPtData

              Set swModelEndPt = swMathUtil.CreatePoint(vPtData)

             

             

              ' Start creating drawing of the model

              Set swDraw = swApp.NewDocument("C:\Program Files\SolidWorks\data\templates\drawing.drwdot", swDwgPaperAsize, 0, 0)

              Set swDrawModel = swDraw

             

              bRet = swDraw.Create3rdAngleViews2(swModel.GetPathName)

              Debug.Assert bRet

             

              Set swView = swDraw.GetFirstView

              Set swView = swView.GetNextView

              Do While Not swView Is Nothing

                  ' Select regardless

                  bRet = swView.SelectEntity(swEnt, False)

                  Debug.Assert bRet

                 

                  vOutline = swView.GetOutline

                 

                  Set swViewXform = swView.ModelToViewTransform

                  Set swViewStartPt = swModelStartPt.MultiplyTransform(swViewXform)

                  Set swViewEndPt = swModelEndPt.MultiplyTransform(swViewXform)

                 

                  Debug.Print "View       = " & swView.Name

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

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

                  Debug.Print ""

                 

                  If Abs(swViewStartPt.ArrayData(0) - swViewEndPt.ArrayData(0)) < nTolerance Then

                      ' Must be vertical

                      ' Place dimension midway up edge and to the right of view

                      nXpos = vOutline(0) - nXoffset

                      nYpos = Abs((swViewStartPt.ArrayData(1) + swViewEndPt.ArrayData(1)) / 2#)

                     

                      ' NULL if cannot convert edge in this view

                      Set swDispDim = swDrawModel.AddVerticalDimension2(nXpos, nYpos, 0#)

                  ElseIf Abs(swViewStartPt.ArrayData(1) - swViewEndPt.ArrayData(1)) < nTolerance Then

                      ' Must be horizontal

                      ' Place dimension midway across edge and above view

                      nXpos = Abs((swViewStartPt.ArrayData(0) + swViewEndPt.ArrayData(0)) / 2#)

                      nYpos = vOutline(3) + nYoffset

                     

                      ' NULL if cannot convert edge in this view

                      Set swDispDim = swDrawModel.AddHorizontalDimension2(nXpos, nYpos, 0#)

                  Else

                      ' Neither horizontal or vertical

                      ' Place dimension near middle of edge

                      nXpos = Abs((swViewStartPt.ArrayData(0) + swViewEndPt.ArrayData(0)) / 2#) + nXoffset

                      nYpos = Abs((swViewStartPt.ArrayData(1) + swViewEndPt.ArrayData(1)) / 2#) + nYoffset

             

                      ' Depends on the orientation of the entity in the drawing view,

                      ' thus, could be NULL

                      '

                      ' Create the dimension even if the entity is not

                      ' visible in the drawing view

                      Set swDispDim = swDrawModel.AddDimension2(nXpos, nYpos, 0#)

                  End If

                 

                  Set swView = swView.GetNextView

              Loop

          End Sub

          '-------------------------------------------

            • Re: SwDim.ReferencePoints+MathPoint
              Yong Ning

              Reference.jpg

               

               

               

              ''

              '

              Function DelSkPt(SwModel As ModelDoc2, SwSk As Sketch)

                   Dim Ss

                   Dim SkPt As SketchPoint

                       ''

                       If IsEmpty(SwSk.GetSketchPoints) Then

                           Exit Function

                       End If

                       For Each Ss In SwSk.GetSketchPoints

                           Set SkPt = Ss

                           SkPt.Select True

                       Next

                       SwModel.EditDelete

              End Function

              ''

              ''

              Function RetuDimArr(SwView As View, SwDim As Dimension, oScale)

                  Dim vPos, Pt(2, 1), MathPt As MathPoint

                  Dim Ss, ii, jj

                       vPos = SwView.Position

                       Ss = SwDim.ReferencePoints

                       ''

                       For jj = 0 To 2

                                Set MathPt = Ss(jj)

                                Set MathPt = MathPt.MultiplyTransform(SwView.ModelToViewTransform)

                                With MathPt

               

               

                                    Pt(jj, 0) = .ArrayData(0) * oScale

                                    Pt(jj, 1) = .ArrayData(1) * oScale

                                End With

                       Next jj

                       RetuDimArr = Pt

              End Function

               

               

               

               

              Private Sub del()

                  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, SwDim As Dimension

                  Dim SwAnn As Annotation

                  Dim oScale, Xx, Yy

                  Dim SwSheet As Sheet

                  Dim SkPt As SketchPoint

                  Dim SwView As View

                  Dim Anns, Arr

                  Dim ii, jj ', Xx, Yy

                  Dim Ss, Ss1

                  Dim SwMathUtil As MathUtility

                  Dim MathPt As MathPoint

                      Set SwMathUtil = SwApp.GetMathUtility

                    

                      Set SwSheet = SwDraw.GetCurrentSheet

               

               

                      Set SwView = SwDraw.GetFirstView

                      DelSkPt SwModel, SwView.GetSketch

                      Set SwView = SwView.GetNextView

                      Anns = SwView.GetAnnotations

                 

                      For ii = 0 To UBound(Anns)

                          Set SwAnn = Anns(ii)

                          Debug.Print SwAnn.GetType

                          If SwAnn.GetName = "ArcLen" Then

                          'If SwAnn.GetName = "b1" Then

                                Ss = SwAnn.GetPosition

                                Set SwDispDim = SwAnn.GetSpecificAnnotation

                                Set SwDim = SwDispDim.GetDimension

                              

                                Arr = RetuDimArr(SwView, SwDispDim.GetDimension, SwSheet.GetProperties(3))

                                For jj = 0 To UBound(Arr)

                                    Xx = Arr(jj, 0)

                                    Yy = Arr(jj, 1)

                                    Set SkPt = SwModel.CreatePoint2(Xx, Yy, 0)

                                Next jj

                                jj = 2

                                Xx = Arr(jj, 0)

                                Yy = 0.15 'Arr(jj, 1) '- 0.005

                                'SwAnn.SetPosition Xx, Yy, 0

                                SwAnn.Select False

                                Ss1 = SwDim.ReferencePoints

                                Set MathPt = Ss1(2)

                                Set MathPt = MathPt.MultiplyTransform(SwView.ModelToViewTransform)

                                With MathPt

                                     SwAnn.SetPosition .ArrayData(0), .ArrayData(1) - 0.01, 0

                                   

                                End With

                          End If

                      Next ii

                    

              End Sub

               

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

              Function MoveArcLenDim(SwView As View, ArcLenDispDim As DisplayDimension, ShellRDispDim As DisplayDimension)

                 

                  Dim Ss

                  Dim SwAnn As Annotation, SwDim As Dimension

                  Dim SwAnn1 As Annotation, SwDim1 As Dimension

                     With ShellRDispDim

                         Set SwAnn1 = .GetAnnotation

                         Set SwDim1 = .GetDimension

                     End With

                     R = SwDim1.Value * 3 / 4000

                  Dim MathPt As MathPoint

                    

                     ''

                     With ArcLenDispDim

                         Set SwAnn = .GetAnnotation

                         Set SwDim = .GetDimension

                     End With

                     Set MathPt = SwDim.ReferencePoints(2)

                     Set MathPt = MathPt.MultiplyTransform(SwView.ModelToViewTransform)

                     With MathPt

                          SwAnn.SetPosition .ArrayData(0), .ArrayData(1) - R * SwView.ScaleDecimal, 0

                     End With

                    

              End Function

               

               

              Sub del()

                 Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

                     Set SwApp = Application.SldWorks

                     Set SwModel = SwApp.ActiveDoc

                 Dim SwDraw As DrawingDoc

                 Dim SwView As View

                 Dim ArcLenDispDim As DisplayDimension, ShellRDispDim As DisplayDimension

                 Dim Anns, SwAnn As Annotation

                     Set SwDraw = SwModel

                     Set SwView = SwDraw.GetFirstView

                     Set SwView = SwView.GetNextView

                     ''

                     Anns = SwView.GetAnnotations

                     ''

                     For ii = 0 To UBound(Anns)

                         Set SwAnn = Anns(ii)

                         'Debug.Print SwAnn.GetName, SwAnn.GetType

                         If SwAnn.GetType = 4 Then

                            '''

                            Select Case SwAnn.GetName

                              Case "ArcLen"

                                  Set ArcLenDispDim = SwAnn.GetSpecificAnnotation

                              Case "ShellR"

                                  Set ShellRDispDim = SwAnn.GetSpecificAnnotation

                             End Select

                         End If

                     Next ii

                     ''

                     MoveArcLenDim SwView, ArcLenDispDim, ShellRDispDim

                     Stop

                    

                

                    

              End Sub