3 Replies Latest reply on Jun 7, 2017 2:03 PM by Peter Brinkhuis

    Vertex in sldprt → drawing point in slddrw

    Yong Ning

      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

        • Re: Vertex in sldprt → drawing point in slddrw
          Peter Brinkhuis

          With coordinate system do you use in the drawing, the global one or the one of the view?

            • Re: Vertex in sldprt → drawing point in slddrw
              Yong Ning

              Thanks for your reply, can give a small program code

               

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

              Public Sub GetEndPoints()

               

              Dim swApp, Part, SelMgr As Object

              ' Face object

              Dim faceObj As Object

               

              ' Array of edge objects

              Dim edgeList As Variant

              Dim edgeCount As Long

               

              ' Edge object

              Dim edgeObj As Object

               

              ' Vertex objects

              Dim startVertexObj As Object

              Dim endVertexObj As Object

               

              ' Edge startpoint and endpoint arrays

              Dim startPt As Variant

              Dim endPt As Variant

               

              Set swApp = CreateObject("SldWorks.Application")

              ' Use the active document

              Set Part = swApp.ActiveDoc

              ' Setup to handle user selections

              Set SelMgr = Part.SelectionManager

               

              ' If no selection made, return an error

              If (SelMgr.GetSelectedObjectCount = 0) Then

              swApp.SendMsgToUser ("Select a face first...")

               

              ' Otherwise, continue

              Else

               

              If (SelMgr.GetSelectedObjectType(1) <> 2) Then

              swApp.SendMsgToUser ("Must select a face")

              Exit Sub

              End If

               

              ' Get the selected Face object

              Set faceObj = SelMgr.GetSelectedObject5(1)

               

              ' Get edge count from the face

              edgeCount = faceObj.GetEdgeCount

              ' Get all edges from the face

              edgeList = faceObj.GetEdges

               

              ' For each edge

              For i = 0 To (edgeCount - 1)

              Set edgeObj = edgeList(i)

              ' Get the "Start" vertex

              Set startVertexObj = edgeObj.GetStartVertex

              ' Get the "End" vertex

              Set endVertexObj = edgeObj.GetEndVertex

               

              ' Define message

              Msg = "Edge points: " + Chr(10)

              If (Not startVertexObj Is Nothing) Then

              ' Get the xyz vertex location

              startPt = startVertexObj.GetPoint

              Msg = Msg + Str$(startPt(0)) + "," + Str$(startPt(1)) + "," + Str$(startPt(2)) + Chr(10)

              End If

               

              If (Not endVertexObj Is Nothing) Then

              ' Get the xyz vertex location

              endPt = endVertexObj.GetPoint

              Msg = Msg + Str$(endPt(0)) + "," + Str$(endPt(1)) + "," + Str$(endPt(2))

              End If

               

               

              ' OK Button only

              Style = vbOKOnly

              ' Define title

              Title = "Vertex Info"

              ' Display message to user

              Call MsgBox(Msg, Style, Title)

               

              Next

              End If

               

              End Sub

               

               

               

               

              Sub main1()

                  Dim swApp                       As SldWorks.SldWorks

                  Dim swModel                     As SldWorks.ModelDoc2

                  Dim swSelMgr                    As SldWorks.SelectionMgr

                  Dim swVert                      As SldWorks.Vertex

                  Dim vEdgeArr                    As Variant

                  Dim vEdge                       As Variant

                  Dim swEdge                      As SldWorks.Edge

                  Dim swEnt                       As SldWorks.Entity

                  Dim bRet                        As Boolean

                  Set swApp = Application.SldWorks

                  Set swModel = swApp.ActiveDoc

                  Set swSelMgr = swModel.SelectionManager

                  Set swVert = swSelMgr.GetSelectedObject5(1)

                  swModel.ClearSelection2 True

               

                  vEdgeArr = swVert.GetEdges

                  For Each vEdge In vEdgeArr

                      Set swEdge = vEdge

                      Set swEnt = swEdge

                 

                      bRet = swEnt.Select4(True, Nothing): Debug.Assert bRet

                  Next vEdge

              End Sub

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

              Sub main2()

               

              Dim swApp As SldWorks.SldWorks

              Dim Part As SldWorks.PartDoc

              Dim Body As SldWorks.Body2

              Dim Edge As SldWorks.Edge

              Dim Vertex As SldWorks.Vertex

              Dim Bodyarr As Variant

              Dim vbody As Variant

              Dim Edgearr As Variant

              Dim idx As Long

              Dim vobj As Variant

              Dim crgb As Long

               

              Set swApp = Application.SldWorks

              Set Part = swApp.ActiveDoc

               

              Bodyarr = Part.GetBodies2(swSolidBody, True)

              For Each vbody In Bodyarr

                  Set Body = vbody

                  Edgearr = Body.GetEdges

                  idx = 0

                  For Each vobj In Edgearr

                      Set Edge = vobj

                      Set Vertex = Edge.GetStartVertex

                      Select Case CInt(idx Mod 8)

                      Case 0

                         crgb = RGB(0, 0, 0)

                      Case 1

                         crgb = RGB(0, 0, 255)

                      Case 2

                         crgb = RGB(0, 255, 0)

                      Case 3

                         crgb = RGB(0, 255, 255)

                      Case 4

                         crgb = RGB(255, 0, 0)

                      Case 5

                         crgb = RGB(255, 0, 255)

                      Case 6

                         crgb = RGB(255, 255, 0)

                      Case 7

                         crgb = RGB(255, 255, 255)

                  End Select

                  idx = idx + 1

                  Vertex.Display Part, crgb, 1, True

                 Next

              Next

               

              End Sub

               

               

               

               

               

              2010 SOLIDWORKS API Help - Get Edges for Vertex Example (VBA)  http://help.solidworks.com/2010/english/api/sldworksapi/get_edges_for_vertex_example_vb.htm

               

              2010 SOLIDWORKS API Help - Get Vertex Example (VBA)  http://help.solidworks.com/2010/english/api/sldworksapi/get_vertex_example_vb.htm

               

               

              2010 SOLIDWORKS API Help - Display Vertices Example (VBA)  http://help.solidworks.com/2010/english/api/sldworksapi/display_vertices_example_vb.htm

               

               

               

               

              Private Sub del201706101()

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

                      'Set SwDispDim = SwSelMgr.GetSelectedObject5(1)

                      Set SwDim = SwModel.Parameter("D1@Extrude1@a.Part")

                  Dim Ss, Ss1

                      'Debug.Print SwDispDim.GetDimension.FullName

                     

                  Dim mPt As MathPoint

                      With SwDim

                          Ss = .ReferencePoints

                          For ii = 0 To 2

                             Set mPt = Ss(ii)

                             With mPt

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

                             End With

                          Next ii

                         

                      End With

                      ''

                      Set mPt = Ss(1)

               

               

                      SwModel.ClearSelection2 True

                     

                  Dim SwDraw As DrawingDoc

                      Set SwDraw = SwModel

                  Dim SwView As View

                      Set SwView = SwDraw.GetFirstView

                      Set SwView = SwView.GetNextView

                  Dim SwXForm As MathTransform

                      Set SwXForm = SwView.ModelToViewTransform

                  Dim SwMathUtil As MathUtility

                      Set SwMathUtil = SwApp.GetMathUtility

                  Dim MathPt As MathPoint, Pt(2) As Double

                      With mPt

                          Pt(0) = .ArrayData(0)

                          Pt(1) = .ArrayData(1)

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

                      End With

                     

                      Set MathPt = SwMathUtil.CreatePoint(Pt)

                      Set MathPt = mPt.MultiplyTransform(SwXForm)

                  Dim Xx, Yy, oScale

                     

                      With MathPt

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

                          Xx = .ArrayData(0)

                          Yy = .ArrayData(1)

                          Xx = Xx / SwView.ScaleDecimal

                          Yy = Yy / SwView.ScaleDecimal

                      End With

                  Dim SkPt As SketchPoint

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

                     

              End Sub

                • Re: Vertex in sldprt → drawing point in slddrw
                  Peter Brinkhuis

                  You can try this:

                  • Select a drawing view and insert a sketch point
                  • Select the sheet and insert a sketch point

                  The point will show up at different locations. To make sure your sketch item is placed correctly, you need to select the correct drawing view first. The sheet itself is considered by SolidWorks as the first drawing view. When you have the drawingDoc object, GetFirstView will get you the sheet object. After that you can use GetNextView on the view object to get the first real view.