13 Replies Latest reply on Jan 29, 2015 4:22 AM by Solidworks Selim

    solidworks how to get the center points  selected entities

    Solidworks Selim

      solidworks how to get the center points  selected entities macro

       

      circles point to Macro

        • Re: solidworks how to get the center points  selected entities
          Keith Rice
          Dim swApp As SldWorks.SldWorks
          Dim swModel As SldWorks.ModelDoc2
          Dim swSelMgr As SldWorks.SelectionMgr
          Dim swSkPt As SldWorks.SketchPoint
          
          Sub main()
              Set swApp = Application.SldWorks
              Set swModel = swApp.ActiveDoc
              Set swSelMgr = swModel.SelectionManager
              Set swSkPt = swSelMgr.GetSelectedObject6(1, -1)
              Debug.Print Round(swSkPt.X, 6), Round(swSkPt.Y, 6), Round(swSkPt.Z, 6)
          End Sub
          

           

          Keith

          SolidWorks API Tutorials

              • Re: solidworks how to get the center points  selected entities
                Raghvendra Bhargava

                Hi,

                Please try this...

                Before Run the macro, select the sketch at feature manager tree.See at Immediate window...it will give you all detail about the circle, including center point...

                 

                Option Explicit

                 

                 

                Public Enum swSkSegments_e

                    swSketchARC = 1

                End Enum

                 

                Function TransformSketchPointToModelSpace(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swSketch As SldWorks.Sketch, swSkPt As SldWorks.SketchPoint) As SldWorks.MathPoint

                 

                    Dim swMathUtil              As SldWorks.MathUtility

                    Dim swXform                 As SldWorks.MathTransform

                    Dim nPt(2)                  As Double

                    Dim vPt                     As Variant

                    Dim swMathPt                As SldWorks.MathPoint

                 

                    nPt(0) = swSkPt.X:      nPt(1) = swSkPt.Y:      nPt(2) = swSkPt.Z

                 

                 

                    vPt = nPt

                 

                 

                    Set swMathUtil = swApp.GetMathUtility

                 

                 

                    Set swXform = swSketch.ModelToSketchTransform

                 

                 

                    Set swXform = swXform.Inverse

                 

                 

                    Set swMathPt = swMathUtil.CreatePoint((vPt))

                 

                 

                    Set swMathPt = swMathPt.MultiplyTransform(swXform)

                 

                 

                    Set TransformSketchPointToModelSpace = swMathPt

                 

                 

                End Function

                 

                 

                Sub ProcessSketchArc(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swSketch As SldWorks.Sketch, swSkArc As SldWorks.SketchArc)

                 

                 

                    Dim swStartPt               As SldWorks.SketchPoint

                    Dim swEndPt                 As SldWorks.SketchPoint

                    Dim swCtrPt                 As SldWorks.SketchPoint

                    Dim vNormal                 As Variant

                    Dim swStartModPt            As SldWorks.MathPoint

                    Dim swEndModPt              As SldWorks.MathPoint

                    Dim swCtrModPt              As SldWorks.MathPoint

                 

                    Set swStartPt = swSkArc.GetStartPoint2

                    Set swEndPt = swSkArc.GetEndPoint2

                 

                 

                    Set swCtrPt = swSkArc.GetCenterPoint2

                    Set swStartModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swStartPt)

                    Set swEndModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swEndPt)

                    Set swCtrModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swCtrPt)

                 

                    vNormal = swSkArc.GetNormalVector

                 

                    Debug.Print "      Start (sketch)   = (" & swStartPt.X * 1000# & ", " & swStartPt.Y * 1000# & ", " & swStartPt.Z * 1000# & ") mm"

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

                 

                 

                    Debug.Print "      End   (sketch)   = (" & swEndPt.X * 1000# & ", " & swEndPt.Y * 1000# & ", " & swEndPt.Z * 1000# & ") mm"

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

                 

                    Debug.Print "      Center(sketch)   = (" & swCtrPt.X * 1000# & ", " & swCtrPt.Y * 1000# & ", " & swCtrPt.Z * 1000# & ") mm"

                 

                    Debug.Print "      Center(model )   = (" & swCtrModPt.ArrayData(0) * 1000# & ", " & swCtrModPt.ArrayData(1) * 1000# & ", " & swCtrModPt.ArrayData(2) * 1000# & ") mm"

                 

                    Debug.Print "      Radius           = " & swSkArc.GetRadius * 1000# & " mm"

                    Debug.Print "      IsCircle         = " & CBool(swSkArc.IsCircle)

                    Debug.Print "      Rot dirn         = " & swSkArc.GetRotationDir

                End Sub

                 

                 

                Sub main()

                 

                    Dim sSkSegmentsName(5)      As String

                    Dim swApp                   As SldWorks.SldWorks

                    Dim swModel                 As SldWorks.ModelDoc2

                    Dim swSelMgr                As SldWorks.SelectionMgr

                    Dim swFeat                  As SldWorks.Feature

                    Dim swSketch                As SldWorks.Sketch

                    Dim vSkSegArr               As Variant

                    Dim vSkSeg                  As Variant

                    Dim swSkSeg                 As SldWorks.SketchSegment

                    Dim swSkArc                 As SldWorks.SketchArc

                    Dim vID                     As Variant

                 

                 

                    Dim i                       As Long

                    Dim bRet                    As Boolean

                    sSkSegmentsName(swSketchARC) = "swSketchARC"

                    Set swApp = Application.SldWorks

                    Set swModel = swApp.ActiveDoc

                    Set swSelMgr = swModel.SelectionManager

                    Set swFeat = swSelMgr.GetSelectedObject5(1)

                    Set swSketch = swFeat.GetSpecificFeature

                    Debug.Print "Feature = " & swFeat.Name & " [" & swSketch.Is3D & "]"

                    Debug.Print "  Sketch Segments:"

                    vSkSegArr = swSketch.GetSketchSegments

                 

                    For Each vSkSeg In vSkSegArr

                        Set swSkSeg = vSkSeg

                        vID = swSkSeg.GetID

                        Debug.Print "    ID = [" & vID(0) & "," & vID(1) & "]"

                        Debug.Print "      Type             = " & sSkSegmentsName(swSkSeg.GetType)

                        Debug.Print "      ConstGeom        = " & swSkSeg.ConstructionGeometry

                 

                        Select Case swSkSeg.GetType

                 

                            Case swSketchARC

                                Set swSkArc = swSkSeg

                                ProcessSketchArc swApp, swModel, swSketch, swSkArc

                            Case Default

                                Debug.Assert False

                        End Select

                    Next vSkSeg

                End Sub

                 

                let me know if you need any update...

                • Re: solidworks how to get the center points  selected entities
                  Solidworks Selim

                  batch center points select

                  center points select macro

              • Re: solidworks how to get the center points  selected entities
                Ivana Kolin

                Dim swApp As SldWorks.SldWorks

                Dim Part As SldWorks.ModelDoc2

                Dim boolstatus As Boolean

                Dim longstatus As Long, longwarnings As Long

                 

                 

                Sub main()

                 

                 

                Dim i As Integer

                Dim ent As Object

                Dim swSketchSegment As SldWorks.SketchSegment

                Dim swSketchArc As SldWorks.SketchArc

                Dim swSketch As SldWorks.Sketch

                 

                 

                Dim swSketchPoint As SldWorks.SketchPoint

                 

                 

                Dim vSketchSelPt            As Variant

                Dim vModelSelPt             As Variant

                Dim nPt(2)                  As Double

                 

                 

                 

                 

                Set swApp = Application.SldWorks

                Set Part = swApp.ActiveDoc

                Dim swSelMgr As SldWorks.SelectionMgr

                Set swSelMgr = Part.SelectionManager

                 

                 

                 

                For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)

                    If swSelMgr.GetSelectedObjectType3(i, -1) <> swSelSKETCHSEGS And swSelMgr.GetSelectedObjectType3(i, -1) <> swSelEXTSKETCHSEGS Then

                      MsgBox "Selected entity is not sketch segment"

                    Else

                        Set ent = swSelMgr.GetSelectedObject6(i, -1)

                        Set swSketchSegment = ent

                        Set swSketchArc = ent

                        If swSketchArc Is Nothing Then

                            MsgBox "Selected entity is not arc"

                        Else

                            Set swSketchPoint = swSketchArc.GetCenterPoint2

                            Debug.Print "CenterPoint " & i & " in sketch space = (" & swSketchPoint.X * 1000# & ", " & swSketchPoint.Y * 1000# & ", " & swSketchPoint.Z * 1000# & ") mm"

                            Set swSketch = swSketchSegment.GetSketch

                            nPt(0) = swSketchPoint.X:      nPt(1) = swSketchPoint.Y:      nPt(2) = swSketchPoint.Z

                            vSketchSelPt = nPt

                            vModelSelPt = GetModelCoordinates(swApp, swSketch, vSketchSelPt)

                      

                      

                            Debug.Print "CenterPoint " & i & " in model  space = (" & vModelSelPt(0) * 1000# & ", " & vModelSelPt(1) * 1000# & ", " & vModelSelPt(2) * 1000# & ") mm"

                        End If

                    End If

                Next i

                 

                 

                 

                 

                End Sub

                 

                 

                Public Function GetModelCoordinates(swApp As SldWorks.SldWorks, swSketch As SldWorks.Sketch, vPtArr As Variant) As Variant

                 

                 

                    Dim swMathPt                    As SldWorks.MathPoint

                    Dim swMathUtil                  As SldWorks.MathUtility

                    Dim swMathTrans                 As SldWorks.MathTransform

                    Set swMathUtil = swApp.GetMathUtility

                    Set swMathPt = swMathUtil.CreatePoint(vPtArr)

                 

                 

                    ' Is a unit transform if 3D sketch; for example, selected sketch

                    ' point is automatically in model space

                 

                 

                    Set swMathTrans = swSketch.ModelToSketchTransform

                    Set swMathTrans = swMathTrans.Inverse

                    Set swMathPt = swMathPt.MultiplyTransform(swMathTrans)

                    GetModelCoordinates = swMathPt.ArrayData

                End Function