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!

Macro "wait" till I select surface -possible? 1

Status
Not open for further replies.

picia

Mechanical
Mar 24, 2006
26
hello.
I try make it but I dont know how... Below is the code macro from internet.I dont give my code because is very long... I want make that when i run it I have information for example:Select Surface. Then macro "wait" for me and I can select surface and click ok or something like that.I want make that I dont need before I run macro select the surface only when macro is runing... If You have any ideas please help me.I willby greatful for Your help...
Example code:

Sub GetXYZofSurfaceCentroid()
'***********************************
'Get XYZ coordinates of centroid and load
'them into array "XYZ"
'***********************************

Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim SelMgr As SldWorks.SelectionMgr
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As SldWorks.Feature
Dim MathPoint As SldWorks.MathPoint
Dim RefPoint As SldWorks.RefPoint
Dim vRefPointFeatureArray As Variant
Dim XYZ As Variant
Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
'If SelMgr.GetSelectedObjectCount2(-1) <> 1 Then
' MsgBox "You must select a single face/surface for this macro."
' Exit Sub
'ElseIf SelMgr.GetSelectedObjectType3(1, -1) <> swSelFACES Then
' MsgBox SelMgr.GetSelectedObjectType3(1, -1)
' MsgBox "You must select a single face/surface for this macro."
' Exit Sub
'End If

vRefPointFeatureArray = Part.FeatureManager.InsertReferencePoint(4, 0, 0.01, 1)
Set Feature = vRefPointFeatureArray(0)
Set RefPoint = Feature.GetSpecificFeature2
Set MathPoint = RefPoint.GetRefPoint
XYZ = MathPoint.ArrayData
Set MathPoint = Nothing
Set RefPoint = Nothing
Set Feature = Nothing
'Part.Extension.DeleteSelection2 (2)
MsgBox "X: " & XYZ(0) * 1000 & vbCrLf & "Y: " & XYZ(1) * 1000 & vbCrLf & "Z: " & XYZ(2) * 1000
End Sub
 
Replies continue below

Recommended for you


I actually just posted this macro in the thread above, but here it is in a more appropriate setting.

It will prompt the user with a message box to make a selection. After the user clears the box it will wait for a selection. As soon as the user makes any selection the routine will resume, giving some info about the selected object(s)

If you wish to select multiple objects, simply change the value of MINSELECTIONS to the number of selections desired.


Code:
Sub WaitForUserSelection()
Dim swApp As SldWorks.SldWorks
Dim SelMgr As SldWorks.SelectionMgr
Dim swDoc As SldWorks.ModelDoc2
Dim nContinue As Integer
Dim SelType As SwConst.swSelectType_e
Dim sMsg As String
Dim i As Long

Const MINSELECTIONS = 1

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

MsgBox "Please select something... Anything!"
While nContinue <> vbNo
    swDoc.ClearSelection2 True   'Clear all selections

'''''''''''''''''''''''''
'This section is the actual "waiting" portion.
    While SelMgr.GetSelectedObjectCount < MINSELECTIONS
        DoEvents   'Wait for user selection
    Wend
''''''''''''''''''''''''''
    
    sMsg = "You actually picked " & _
           SelMgr.GetSelectedObjectCount & _
           " things! Object types selected are:" & vbCrLf
           
    For i = 1 To SelMgr.GetSelectedObjectCount
        SelType = SelMgr.GetSelectedObjectType3(i, -1)
        sMsg = sMsg & vbCrLf & i & ". " & SelType
    Next
    
    nContinue = MsgBox(sMsg & vbCrLf & vbCrLf & "Keep going?", vbYesNo)
Wend

End Sub
 
Below is the macro you posted originally, modified so that a face may be pre-selected, but if not, the user will be prompted to pick one face until one face is picked. Cancel is available after one failed attempt at choosing a face.

Code:
Sub GetXYZofSurfaceCentroid()
'***********************************
'Get XYZ coordinates of centroid and load
'them into array "XYZ"
'***********************************

Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim SelMgr As SldWorks.SelectionMgr
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As SldWorks.Feature
Dim MathPoint As SldWorks.MathPoint
Dim RefPoint As SldWorks.RefPoint
Dim vRefPointFeatureArray As Variant
Dim XYZ As Variant
Dim nUserCancel As Integer

Set swApp = Application.SldWorks


Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
If (SelMgr.GetSelectedObjectCount2(-1) <> 1) Or (SelMgr.GetSelectedObjectType3(1, -1) <> swSelFACES) Then
    MsgBox "Please select a face to continue"
    Part.ClearSelection2 True
    While (SelMgr.GetSelectedObjectCount <> 1) Or (SelMgr.GetSelectedObjectType3(1, -1) <> swSelFACES)
        If SelMgr.GetSelectedObjectCount = 1 And SelMgr.GetSelectedObjectType3(1, -1) <> swSelFACES Then
            nUserCancel = MsgBox("Please select one face or cancel to exit", vbOKCancel)
            If nUserCancel = vbCancel Then
                Exit Sub
            End If
            Part.ClearSelection2 True
        Else
            DoEvents
        End If
    Wend
End If

vRefPointFeatureArray = Part.FeatureManager.InsertReferencePoint(4, 0, 0.01, 1)
Set Feature = vRefPointFeatureArray(0)
Set RefPoint = Feature.GetSpecificFeature2
Set MathPoint = RefPoint.GetRefPoint
XYZ = MathPoint.ArrayData
Set MathPoint = Nothing
Set RefPoint = Nothing
Set Feature = Nothing
'Part.Extension.DeleteSelection2 (2)
MsgBox "X: " & XYZ(0) * 1000 & vbCrLf & "Y: " & XYZ(1) * 1000 & vbCrLf & "Z: " & XYZ(2) * 1000
End Sub
 
Thanks Handleman for your help.... I only need this part:
'This section is the actual "waiting" portion.
While SelMgr.GetSelectedObjectCount < MINSELECTIONS
DoEvents 'Wait for user selection
Wend
and this is what i needed.Thanks oncemore...
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor