Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations GregLocock on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Coordinates of point - macro

Status
Not open for further replies.

picia

Mechanical
Mar 24, 2006
26
Hello.I'm working with SolidWorks API not so long.I try make, then find macro which allow get coordintes of point (for example of surface). I don't want vertex and edge point because this I know how get. I want get coordinates any point of surface... If You have any odeas and have time to help me I willbe greatful...
 
Replies continue below

Recommended for you

How will the point be located? Will it be a sketch point that is selected by the user? An arbitrary point closest to where the user clicked to select the surface?
 
It willbe good when this point is the closest to where the user clicked to select surface, if it is possible...
 
Gets X, Y, Z of selection point in millimeters.

Code:
Private Sub SurfPoint()
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim SelMgr As SldWorks.SelectionMgr
Dim NumSelects As Long
Dim SelectedObj As Object
Dim PickPoint As Variant
Dim StickPoint As Variant
Dim sMsg As String
Dim UnitFactor As Double

UnitFactor = 1000 'Get from m to mm

Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set SelMgr = swDoc.SelectionManager

NumSelects = SelMgr.GetSelectedObjectCount
If NumSelects = 0 Then
    MsgBox "Pick a surface and run macro again"
    Exit Sub
End If


Set SelectedObj = SelMgr.GetSelectedObject(NumSelects)
PickPoint = SelMgr.GetSelectionPoint2(NumSelects, -1)
If SelMgr.GetSelectedObjectType3(NumSelects, -1) = 2 Then
    sMsg = "X: " & Str(PickPoint(0) * UnitFactor) & vbCrLf & _
            "Y: " & Str(PickPoint(1) * UnitFactor) & vbCrLf & _
            "Z: " & Str(PickPoint(2) * UnitFactor)
    MsgBox sMsg
Else
    MsgBox "You must select a surface"
End If




Set SelectedObj = Nothing
Set SelMgr = Nothing
Set swDoc = Nothing
Set swApp = Nothing

End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor