Custom Action Macro

[Anonymous]

Hi all. I'm new to programming in general but I'm trying to create a visual basic macro for a custom action that loops through a few probed features that I have in my template.and checks that their Sphericity, Cylindricity, Circularity, or Flatness is not over a pre programmed limit. And then if it is, the macro would pop-up a message box that would inform the operator.

I've looked through the Automation Reference a little bit, and found IFeat_SphereItem that looks like it has PropertySphericity that I may be able to use, but I'm not sure how.

But what I was hoping for was someone that had (or could build) some examples of looping through features and looking at their results, or some guidance in general.

Thanks!

[Anonymous]

Well, I couldn't figure out flatness and decided I didn't need cylindricity, but here's what I came up with:

Sub CheckMeasures()

	Dim ad : set ad = Application.ActiveDocument
		If ad Is Nothing Then Exit Sub
	Dim am : set am = ad.ActiveMeasure
		If am Is Nothing Then Exit Sub
	Dim ai : set ai = ad.ActiveItem  ' get the current active item 
	dim G, i, msg, check, index, list, result, badItems, x
	Set badItems = CreateObject("Scripting.Dictionary")	
	index = 0
	
	for each G in ad.SequenceItems 
		if G.itemtype = 36006 then ' Feature Group ItemType
			for each i in G.SequenceItems
				Select Case i.ItemType
					Case PWI_EntityItemType.pwi_ent_Feat_ProbedCircle_
						check = FormatNumber(i.PropertyCircularity.Measured(am), 4)
						if check > 0.010 then
							index = index + 1 : badItems.add index, i
							list = list & vbLF & "Feature: " & i.Name & "     " & vbTab & i.PropertyCircularity.Name & ": " & check
						End if
					Case PWI_EntityItemType.pwi_ent_Feat_Sphere_
						check = FormatNumber(i.PropertySphericity.Measured(am), 4)
						if check > 0.010 then
							index = index + 1 : badItems.add index, i
							list = list & vbLF & "Feature: " & i.Name & "     " & vbTab & i.PropertySphericity.Name & ": " & check
						end if
				End Select
			next
		end if
	next
	
	if badItems.Count = 0 then Exit Sub
	
	msg = "The following " & badItems.Count & " measured features are out of tolerance: " & vbLF
	msg = msg & list & vbLF & vbLF & "Please click OK to reset these items, and re-play all."
	result = MsgBox(msg, 49, "Measure Check")
	
	if result = 2 then exit sub
	
	for each x in badItems
		badItems.Item(x).Invalidate(am)
	next
   
	ad.PlayAll()
   
End Sub

[alexey.zorin · Accepted solution]

Hello Seth,

You are very good in programming VB-Script macro for PowerInspect!

Here is the list of properties you do need:

pwi_ent_Feat_ProbedCircle_ correspond to PropertyCircularity

pwi_ent_Feat_Sphere_  correspond to PropertySphericity

pwi_ent_Plane_Probed_ correspond to PropertyPlanarity

pwi_ent_Feat_Cylinder_ correspond to PropertyCylindricity

Also The FormatNumber function returns an _expression_ formatted as a number.

It is not a reason to use it in comparison to limit (0.01).

So your macro would be corrected as:

  Dim dCheck

 for each G in ad.SequenceItems
  if G.itemtype = 36006 then ' Feature Group ItemType
   for each i in G.SequenceItems
    Select Case i.ItemType
     Case PWI_EntityItemType.pwi_ent_Feat_ProbedCircle_

      dCheck = i.PropertyCircularity.Measured(am)
      if  dCheck > 0.010 then
       index = index + 1 : badItems.add index, i
       list = list & vbLF & "Feature: " & i.Name & "     " & vbTab & i.PropertyCircularity.Name & ": " & FormatNumber(dCheck, 4)
      End if
     Case PWI_EntityItemType.pwi_ent_Feat_Sphere_

      dCheck = i.PropertySphericity.Measured(am)
      if dCheck > 0.010 then
       index = index + 1 : badItems.add index, i
       list = list & vbLF & "Feature: " & i.Name & "     " & vbTab & i.PropertySphericity.Name & ": " & FormatNumber(dCheck, 4)
      end if
     Case PWI_EntityItemType.pwi_ent_Plane_Probed_

      dCheck = i.PropertyPlanarity.Measured(am)
      if dCheck > 0.010 then
       index = index + 1 : badItems.add index, i
       list = list & vbLF & "Feature: " & i.Name & "     " & vbTab & i.PropertyPlanarity.Name & ": " & FormatNumber(dCheck, 4)
      end if
     Case PWI_EntityItemType.pwi_ent_Feat_Cylinder_

      dCheck = i.PropertyCylindricity.Measured(am)
      if dCheck > 0.010 then
       index = index + 1 : badItems.add index, i
       list = list & vbLF & "Feature: " & i.Name & "     " & vbTab & i.PropertyCylindricity.Name & ": " & FormatNumber(dCheck, 4)
      end if
    End Select
   next
  end if
 next

Hope this modification would works for you.

However I'd suggest to you to use CustomStop item.

It would check any item in a group out of tolerance.

During Play All so PI will stops displaying a message pointing on an item that actually out of tolerance.

Benefit of this method allows you to take in account actual limit values defined for each individual item.

Sample picture attached:

Also it's possible to define each individual items to check.

Please click on the Accept as Solution button if my post solves your issue or answers your question.

Regards,

Alexey

[Anonymous]

Thank you very much for your suggestions. They are a big help.