AnsweredAssumed Answered

Vertex in sldprt → drawing point in slddrw

Question asked by Yong Ning on Jun 7, 2017
Latest reply on Jun 7, 2017 by Peter Brinkhuis

Vertex.jpg

vertex in sldprt

Hope, drawing a point in slddrw

 

Vertex1.jpg

 

follow code, drawing a point  is error.

 

 

 

 

Private Sub del()

    Dim SwSelMgr As SelectionMgr, SwMathUtil As MathUtility

    Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

        Set SwApp = Application.SldWorks

        Set SwModel = SwApp.ActiveDoc

        Set SwMathUtil = SwApp.GetMathUtility

 

    Dim SwDraw As DrawingDoc

        Set SwDraw = SwModel

    Dim SwView As View

        Set SwView = SwDraw.GetFirstView

        Set SwView = SwView.GetNextView

        ''

        Set SwModel = SwView.ReferencedDocument

        Set SwSelMgr = SwModel.SelectionManager

    Dim SwVertex As Vertex

        Set SwVertex = SwSelMgr.GetSelectedObject5(1)

 

    Dim SwMathPt As MathPoint, Pt(2)

        With SwVertex

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

            Pt(0) = .GetPoint(0)

            Pt(1) = .GetPoint(1)

            Pt(2) = .GetPoint(2)

        End With

        ''

        Set SwMathPt = SwMathUtil.CreatePoint(Pt)

        With SwMathPt

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

        End With

        tmp = SwView.SelectEntity(SwVertex, True)

        ''

    Dim vOutLine

        vOutLine = SwView.GetOutline

    Dim SwXForm As MathTransform

        Set SwXForm = SwView.ModelToViewTransform

    Dim SwViewPt As MathPoint

        Set SwViewPt = SwMathPt.MultiplyTransform(SwXForm)

    Dim SkPt As SketchPoint

    Dim Xx As Double, Yy As Double, Zz As Double

        With SwViewPt

            Xx = .ArrayData(0)

            Yy = .ArrayData(1)

            Zz = .ArrayData(2)

        End With

    Dim oScale

        oScale = 1 / SwView.ScaleDecimal

        '

        Xx = Xx * oScale

        Yy = Yy * oScale

        Zz = Zz * oScale

        ''

        Xx = vOutLine(0) + Xx

        Yy = vOutLine(1) + Yy

   

        Set SkPt = SwDraw.CreatePoint2(Xx, Yy, Zz)

        Stop

 

End Sub

 

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

 

how to get coordinates of selected vertexes on ... | SOLIDWORKS Forums  https://forum.solidworks.com/message/141098#141098#141098

 

Dim swMathUtils As SldWorks.MathUtility

Dim swXform As SldWorks.MathTransform

Dim swMathPt As SldWorks.MathPoint

 

Set swMathUtils = swApp.GetMathUtility

 

Set swXform = swView.ModelToViewTransform

 

Set swMathPt = swMathUtils.CreatePoint(swVertex.GetPoint())

Set swMathPt = swMathPt.MultiplyTransform(swXform)

 

'Now the coordinates converted to drawing space

Debug.Print swMathPt.ArrayData(0) & "; " & swMathPt.ArrayData(1)

 

 

Private Sub del20170609()

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

        Set SwDispDim = SwSelMgr.GetSelectedObject5(1)

        Set SwAnn = SwDispDim.GetAnnotation

    Dim Ss, Ss1

        With SwAnn

            Ss = .GetAttachedEntities

            Ss1 = .GetAttachedEntityTypes

        End With

    Dim SkPt As SketchPoint, PtArr(2) As Double

        Set SkPt = Ss(0)

        With SkPt

            Debug.Print .X, .Y, .Z

            PtArr(0) = .X

            PtArr(1) = .Y

        End With

        Stop

    Dim SwDraw As DrawingDoc

        Set SwDraw = SwModel

    Dim SwView As View, vPos

        Set SwView = SwDraw.GetFirstView

        Set SwView = SwView.GetNextView

        vPos = SwView.Position

     

    Dim SwMathUtil As SldWorks.MathUtility

        Set SwMathUtil = SwApp.GetMathUtility

    Dim SwXForm As SldWorks.MathTransform

        Set SwXForm = SwView.ModelToViewTransform

    Dim SwMathPt As SldWorks.MathPoint

        Set SwMathPt = SwMathUtil.CreatePoint(PtArr)

        Set SwMathPt = SwMathPt.MultiplyTransform(SwXForm)

    Dim Xx, Yy, oScale

        oScale = 1 / SwView.ScaleDecimal

        With SwMathPt

            Xx = .ArrayData(0) * oScale + vPos(0)

            Yy = .ArrayData(1) * oScale + vPos(1)

        End With

        Stop

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

End Sub

''

'

''

Private Sub del201706102()

    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, Ss, PtArr

    Dim SwDispDim As DisplayDimension, SwDim As Dimension

   

        Set SwView = SwDraw.GetFirstView

        Do While Not SwView Is Nothing

            Set SwDispDim = SwView.GetFirstDisplayDimension

            Do While Not SwDispDim Is Nothing

                PtArr = retuDimMathPt(SwModel, SwMathUtil, SwView, SwDispDim)

                Set SwDispDim = SwDispDim.GetNext

            Loop

            Set SwView = SwView.GetNextView

        Loop

End Sub

 

 

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

    Dim SkPt As SketchPoint

    Dim SwXForm As MathTransform

        Set SwXForm = SwView.ModelToViewTransform

    Dim SwDim As Dimension, SwAnn As Annotation

        With SwDispDim

             Set SwDim = .GetDimension

             Debug.Print SwDim.FullName

             Set SwAnn = .GetAnnotation

             SwAnn.Select False

        End With

    Dim mPt As MathPoint, Pt(2) As Double

        With SwDim

            Ss = SwAnn.GetPosition

            For ii = 0 To 2

                Debug.Print Round(Ss(ii), 4),

            Next ii

            Xx = Ss(0)

            Yy = Ss(1)

            Xx = Xx / SwView.ScaleDecimal

            Yy = Yy / SwView.ScaleDecimal

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

            Debug.Print

            Stop

            ''

            Ss = .ReferencePoints

            For ii = 0 To 2

               Set mPt = Ss(ii)

               Set mPt = mPt.MultiplyTransform(SwXForm)

               With mPt

                   Xx = .ArrayData(0)

                   Yy = .ArrayData(1)

                   Xx = Xx / SwView.ScaleDecimal

                   Yy = Yy / SwView.ScaleDecimal

                   Debug.Print ii, Xx, Yy

               End With               ''

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

            Next ii

        End With

End Function

Attachments

Outcomes