×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Macro "wait" till I select surface -possible?

Macro "wait" till I select surface -possible?

Macro "wait" till I select surface -possible?

(OP)
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

RE: Macro "wait" till I select surface -possible?

http://www.eng-tips.com/viewthread.cfm?qid=152525&amp;page=1

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

RE: Macro "wait" till I select surface -possible?

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

RE: Macro "wait" till I select surface -possible?

(OP)
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...

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources