'This script has been generated by PowerPCB's VB Script Wizard on 11/15/2023 9:34:56 AM
'It will create reports in Text format.

'This software or file (the “Material”) contains trade secrets or otherwise confidential information owned by Siemens Industry Software Inc. or its affiliates (collectively, “SISW”), or SISW’s licensors. Access to and use of this
'information is strictly limited as set forth in one or more applicable agreement(s) with SISW. This Material may not be copied, distributed, or otherwise disclosed without the express written permission of SISW, and may not be
'used in any way not expressly authorized by SISW.
'
'
'Unless otherwise agreed in writing, SISW has no obligation to support or otherwise maintain this Material. No representation or other affirmation of fact herein shall be deemed to be a warranty or give rise to any liability of
'SISW whatsoever.
'
'
'SISW reserves the right to make changes in specifications and other information contained herein without prior notice, and the reader should, in all cases, consult SISW to determine whether any changes have been made.
'
'
'SISW MAKES NO WARRANTY OF ANY KIND WITH REGARD TO THIS MATERIAL INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT OF INTELLECTUAL PROPERTY. SISW SHALL
'NOT BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, CONSEQUENTIAL OR PUNITIVE DAMAGES, LOST DATA OR PROFITS, EVEN IF SUCH DAMAGES WERE FORESEEABLE, ARISING OUT OF OR RELATED TO THIS PUBLICATION OR THE INFORMATION CONTAINED IN IT,
'EVEN IF SISW HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
'
'
'TRADEMARKS: The trademarks, logos, and service marks (collectively, “Marks”) used herein are the property of Siemens AG, SISW, or their affiliates (collectively, “Siemens”) or other parties. No one is permitted to use these Marks
'without the prior written consent of Siemens or the owner of the Marks, as applicable. The use herein of third party Marks is not an attempt to indicate Siemens as a source of a product, but is intended to indicate a product
'from, or associated with, a particular third party. A list of Siemens’ Marks may be viewed at: www.plm.automation.siemens.com/global/en/legal/trademarks.html


'Pins are counted only once, even for through hole pins
'The Output is in Inches squared for designs in Mils or Inches, and in in Centimeters squared for design in metric
'Arrays of column name and widths. You can modify them to rename, shrink, or expand columns
Const Columns = Array("")
Const Widths  = Array(     50)
'Array of column alignment: 0 - Align Left, 1 - Align Right, 2 - Align Center.
Const Align   = Array(     0)
Dim Unit

Dim PinsTop
Dim PinsBot
Dim Board


Sub Main
PinsTop = 0
PinBot = 0

If ActiveDocument.unit = 3 Then
'Inches
Unit = "3"
UnitNM = "Inch"
ElseIf ActiveDocument.unit = 4 Then
'metric
Unit = "4"
UnitNM = "Centimeter"
ElseIf ActiveDocument.unit = 2 Then
'mils
Unit = "3"
UnitNM = "Inch"
End If

If ActiveDocument.BoardOutlineSurface = Empty Then
	MsgBox "A board outline does not exist." & vbCrLf &"The script will now exit."
	Exit Sub
Else
	If Unit = 3 Then
		Board = (ActiveDocument.BoardOutlineSurface(Unit)) * 2
		BoardSingle = ActiveDocument.BoardOutlineSurface(Unit)
	ElseIf Unit = 4 Then 
		Board = ((ActiveDocument.BoardOutlineSurface(Unit)) * 2)/100
		BoardSingle = ActiveDocument.BoardOutlineSurface(Unit)/100
	End If
End If



	fname = ActiveDocument
	If fname = "" Then
		fname = "Untitled"
	End If
	
	tempFile = DefaultFilePath & "\temp.txt"
	Open tempFile For Output As #1
	'Output report header
	Print #1, "Pins per Square " &UnitNM &" Report" &vbCrLf & fname & " on " & Now
	'Print #1

	
	StatusBarText = "Generating report..."
	'Output table header
	L = UBound(Columns)
	CurCol = 0
	For i = 0 to UBound(Columns)
		OutCell Columns(i)
		L = L + Widths(i)
	Next
	Print #1

	'CurCol = 0
	'Outcell "Board area:" &vbCrLf
	
	'Print #1
	
	
	For Each comp In ActiveDocument.Components
		If comp.layer =1 Then
			PinsTop = PinsTop + comp.Pins.Count
			'MsgBox "Top " &comp.Name
			'MsgBox comp.Pins.Count
		Else
			PinsBot = PinsBot + comp.Pins.Count
			'MsgBox "Bottom " &comp.Name
			'MsgBox comp.Pins.Count
		End If
	Next
	
	TopDiv = PinsTop/BoardSingle
	BotDiv = PinsBot/BoardSingle
	
	Print #1, String(L, "-")
	CurCol=0
	outcell "Top"
	Print #1
	Print #1, String(L, "-")
	curcol=0
	outcell "Pins: " &PinsTop
	Print #1
	curcol = 0
	Outcell "Board Area: " &Format(BoardSingle, "0.0000 ") &UnitNM &Chr(178) 
	Print #1

	CurCol=0
	outcell "Pins per " &UnitNM &Chr(178)&": " &Format(TopDiv, "0.00")
	Print #1
	
	Print #1
	
	Print #1, String(L, "-")
	CurCol=0
	outcell "Bottom"
	Print #1
	Print #1, String(L, "-")
	curcol = 0
	CurCol=0
	outcell "Pins: " &PinsBot
	Print #1
	CurCol=0
	Outcell "Board Area: " &Format(BoardSingle, "0.0000 ") &UnitNM &Chr(178)
	Print #1
	CurCol=0
	outcell "Pins per " &UnitNM &Chr(178)&": " &Format(BotDiv, "0.00")
	Print #1
	Print #1


	
	Pins = ActiveDocument.Pins.Count

	Div = Pins/Board
	'Output table rows
		Print #1, String(L, "-")
		Curcol = 0
		outcell "Total"
		Print #1
		Print #1, String(L, "-")
				CurCol=0
		outcell "Pins: " &Pins
		Print #1
		CurCol = 0
		outcell "Board area : " &Format(Board, "0.0000 ") &UnitNM &Chr(178)
		Print #1

		'Print #1

		
		CurCol=0
		outcell "Pins per " &UnitNM &Chr(178)&": " &Format(Div, "0.00")
		Print #1



	StatusBarText = ""
	Close #1
	FillClipboard
	Set WShshell = CreateObject("WScript.Shell")
	App = WShshell.run ("Notepad", 1)
	Wait 0.5
	WShshell.AppActivate App
	WShshell.SendKeys "^V" 'Ctrl+V  Paste
	WShshell.SendKeys "^{Home}" 'Ctrl+Home  Go to top of the document
End Sub

'Pins are not sorted by default (performance issue), so sort them explicitly in report
Function GetSortedPins(obj As Object)
	Set GetSortedPins = obj.Pins
	GetSortedPins.Sort
End Function

Dim CurCol As Integer	'Current column index staring from 0

Sub OutCell (txt As String)
	w   = Widths(CurCol)
	txt = Left(txt, w)
	n   = w - Len(txt)
	If Align(CurCol) = 0 Then
		Print #1, txt; Space(n + 1);
	ElseIf Align(curCol) = 1 Then
		Print #1, Space(n); txt; Space(1);
	Else
		Print #1, Space(n\2); txt; Space(n - n\2 + 1);
	End If
	CurCol = CurCol + 1
End Sub

Sub FillClipboard
	StatusBarText = "Export Data To Clipboard..."
	' Load whole file to string variable    
	tempFile = DefaultFilePath & "\temp.txt"
	Open tempFile  For Input As #1
	L = LOF(1)
	AllData$ = Input$(L,1)
	Close #1
	'Copy whole data to clipboard
	Clipboard AllData$ 
	Kill tempFile
	StatusBarText = ""
End Sub