Sub Main()
Dim PCDApp, PCDPartPrograms, PCDPartProgram, PCDCommands, PCDCommand
Dim numhits As Integer
Set PCDApp = CreateObject ("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands
Dim cmd As Object
Dim Fcntr As Integer
Dim FeatureList(9999)
Dim b As Integer
Dim a As Integer
Fcntr = 0
For Each cmd In PCDCommands
If cmd.IsMeasuredFeature Then
FeatureList(Fcntr) = cmd.ID
Fcntr = Fcntr + 1
End If
If cmd.IsDCCFeature Then
FeatureList(Fcntr) = cmd.ID
Fcntr = Fcntr + 1
End If
Next cmd
b=0
For a =0 To (Fcntr-1)
Set PCDCommand = PCDCommands.Item(FeatureList(a))
nhits = PCDCommand.GetText(N_HITS, 0)
nhits=nhits+b
b=nhits
Next a
MsgBox(b)
'Cleanup
Set PCDApp = Nothing
Set PCDPartPrograms = Nothing
Set PCDPartProgram = Nothing
Set prbhit = Nothing
End Sub
This might not find every type of feature (I have not thoroughly tested it)
Feel free to use and please share any improvements you may make on it.
As always, no express written guarantees.
Sub Main
Dim PCDApp, PCDPartPrograms, PCDPartProgram, PCDCommand, PCDFeatCmd
Dim nhits, total_nhits, total_feature as Integer
Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDPartProgram = PCDPartProgram.Commands
Dim FeatureList$(999999)
Dim cmd as Object
Dim Fcmtr as Integer
Fcntr =0
total_hits =0
For Each cmd in PCDCommands
If cmd.IsMeasuredFeature or cmd.DCCFeature or cmd.IsScan or cmd.IsBasicScan Then
FeatureList(Fcntr) = cmd.id
fname = FeatureList(Fcntr)
Set PCDCommand = PCDCommands.Item(FeatureList(fcntr))
Fcntr = fcntr +1
Set PCDFeatCmd = PCDCommand.FeatureCommand
nhits = PCDFeatCmd.numhits
total_nhits = total_nhits + nhits
msg = "feature (" & fcntr & ") ID = " & fname
msg = msg & chr(10) & chr(10) & "# of hits = " & nhits & chr(10) & chr(10) & "TOTAL # of hits = " & total_nhits
Msgbox msg
End If
Next cmd
msg = "TOTAL # Features = " & fcntr & chr(10) & chr(10) & "TOTAL # hits = " & total_hits
msgbox msg
Set PCDApp = nothing
Set PCDPartPrograms =nothing
Set PCDPartProgram = nothing
End Sub
