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
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?
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
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?
CODE
'***********************************
'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?
'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...