├── .gitignore ├── AltiumScriptCentral.PrjScr ├── LICENSE.txt ├── README.rst ├── changelog.md ├── old ├── MainD.dfm ├── MainD.pas ├── StatsD.dfm └── StatsD.pas └── src ├── Checks ├── CheckComponentLinks.vbs ├── CheckEmbeddedImages.vbs ├── CheckLayers.vbs ├── CheckNameVersionDate.vbs ├── CheckNoSupplierPartNumShown.vbs ├── CheckPcbCompDesignatorRotation.vbs ├── CheckPcbCompPrimitivesLocked.vbs ├── CheckPcbTextHasCorrectOrientation.vbs ├── CheckProjectCompiles.vbs ├── CheckTentedVias.vbs ├── CheckWeHavePcbDocAccess.vbs ├── ComponentValidators │ ├── ComponentValidator.vbs │ ├── ValidateCapacitor.vbs │ ├── ValidateIC.vbs │ ├── ValidateInductor.vbs │ └── ValidateResistor.vbs ├── PowerPortChecker.vbs ├── PreReleaseChecks.dfm └── PreReleaseChecks.vbs ├── Config.vbs ├── Main.dfm ├── Main.vbs ├── Schematic ├── SchCompParamStamper.vbs └── SwapSchematicDesignators.vbs ├── Stats ├── Stats.dfm └── Stats.vbs ├── Tools ├── AddSpecialSchParams.dfm ├── AddSpecialSchParams.vbs ├── CurrentCalculator.dfm ├── CurrentCalculator.vbs ├── DeleteSchematicParameters.dfm ├── DeleteSchematicParameters.vbs ├── DrawPolygon.dfm ├── DrawPolygon.vbs ├── ExitActiveCommand.vbs ├── NumberSchematics.vbs ├── PushProjectParametersToSchematics.vbs ├── RenumberPads.dfm ├── RenumberPads.vbs ├── ResizeDesignators.dfm ├── ResizeDesignators.vbs ├── RotateDesignators.vbs ├── SwapComponents.dfm ├── SwapComponents.vbs └── ViaStamper.vbs ├── UserData └── UserData.vbs └── Util └── Util.vbs /.gitignore: -------------------------------------------------------------------------------- 1 | History/ 2 | __Previews/ -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019 Geoffrey Benjamin Mark Hunter (gbmhunter@gmail.com) 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /old/MainD.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 494 6 | ClientWidth = 953 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = Form1Create 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Label2: TLabel 18 | Left = 730 19 | Top = 20 20 | Width = 159 21 | Height = 39 22 | Caption = 'PCB Tools' 23 | Font.Charset = DEFAULT_CHARSET 24 | Font.Color = clWindowText 25 | Font.Height = -32 26 | Font.Name = 'Tahoma' 27 | Font.Style = [fsBold] 28 | ParentFont = False 29 | end 30 | object Label1: TLabel 31 | Left = 362 32 | Top = 20 33 | Width = 261 34 | Height = 39 35 | Caption = 'Schematic Tools' 36 | Font.Charset = DEFAULT_CHARSET 37 | Font.Color = clWindowText 38 | Font.Height = -32 39 | Font.Name = 'Tahoma' 40 | Font.Style = [fsBold] 41 | ParentFont = False 42 | end 43 | object Label3: TLabel 44 | Left = 66 45 | Top = 20 46 | Width = 211 47 | Height = 39 48 | Caption = 'Project Tools' 49 | Font.Charset = DEFAULT_CHARSET 50 | Font.Color = clWindowText 51 | Font.Height = -32 52 | Font.Name = 'Tahoma' 53 | Font.Style = [fsBold] 54 | ParentFont = False 55 | end 56 | object Panel3: TPanel 57 | Left = 658 58 | Top = 64 59 | Width = 286 60 | Height = 272 61 | ParentBackground = False 62 | TabOrder = 0 63 | end 64 | object Panel2: TPanel 65 | Left = 346 66 | Top = 64 67 | Width = 286 68 | Height = 272 69 | ParentBackground = False 70 | TabOrder = 1 71 | end 72 | object Panel1: TPanel 73 | Left = 34 74 | Top = 64 75 | Width = 286 76 | Height = 272 77 | Ctl3D = True 78 | ParentBackground = False 79 | ParentCtl3D = False 80 | ShowCaption = False 81 | TabOrder = 2 82 | end 83 | object ButPushProjectParameters: TButton 84 | Left = 386 85 | Top = 176 86 | Width = 206 87 | Height = 24 88 | Caption = 'Push Project Parameters To Schematics' 89 | TabOrder = 3 90 | end 91 | object ButRenumberPads: TButton 92 | Left = 706 93 | Top = 176 94 | Width = 206 95 | Height = 24 96 | Caption = 'Renumber Pads' 97 | TabOrder = 4 98 | end 99 | object Button2: TButton 100 | Left = 708 101 | Top = 206 102 | Width = 204 103 | Height = 25 104 | Caption = 'Resize Designators' 105 | TabOrder = 5 106 | end 107 | object ButNumberSchematics: TButton 108 | Left = 388 109 | Top = 142 110 | Width = 204 111 | Height = 25 112 | Caption = 'Number Schematics' 113 | TabOrder = 6 114 | end 115 | object ButRotateDesignators: TButton 116 | Left = 708 117 | Top = 238 118 | Width = 204 119 | Height = 25 120 | Caption = 'Rotate Designators' 121 | TabOrder = 7 122 | end 123 | object ButDeleteSchParams: TButton 124 | Left = 388 125 | Top = 110 126 | Width = 204 127 | Height = 26 128 | Caption = 'Delete Schematic Parameters' 129 | TabOrder = 8 130 | end 131 | object ButAddSpecialSchematicParameters: TButton 132 | Left = 388 133 | Top = 78 134 | Width = 204 135 | Height = 25 136 | Caption = 'Add Special Schematic Parameters' 137 | TabOrder = 9 138 | end 139 | object ButtonDisplayPcbStats: TButton 140 | Left = 708 141 | Top = 110 142 | Width = 204 143 | Height = 25 144 | Caption = 'Display PCB Stats' 145 | TabOrder = 10 146 | OnClick = ButtonDisplayPcbStatsClick 147 | end 148 | object ButtonViaStamper: TButton 149 | Left = 708 150 | Top = 270 151 | Width = 204 152 | Height = 26 153 | Caption = 'Via Stamper' 154 | TabOrder = 11 155 | end 156 | object ButtonDrawPolygon: TButton 157 | Left = 708 158 | Top = 142 159 | Width = 204 160 | Height = 25 161 | Caption = 'Draw Polygon' 162 | TabOrder = 12 163 | end 164 | object ButtonCurrentCalculator: TButton 165 | Left = 708 166 | Top = 78 167 | Width = 204 168 | Height = 26 169 | Caption = 'Current Calculator' 170 | TabOrder = 13 171 | end 172 | object ButtonRunPreReleaseChecks: TButton 173 | Left = 66 174 | Top = 80 175 | Width = 206 176 | Height = 24 177 | Caption = 'Run Pre-release Checks' 178 | TabOrder = 14 179 | OnClick = ButtonRunPreReleaseChecksClick 180 | end 181 | end 182 | -------------------------------------------------------------------------------- /old/MainD.pas: -------------------------------------------------------------------------------- 1 | procedure TForm1.Form1Create(Sender: TObject); 2 | begin 3 | //ShowMessage('Test'); 4 | end; 5 | 6 | procedure TForm1.ButtonRunPreReleaseChecksClick(Sender: TObject); 7 | begin 8 | ShowMessage('Testing'); 9 | end; 10 | 11 | procedure TForm1.ButtonDisplayPcbStatsClick(Sender: TObject); 12 | begin 13 | FormStatsD.ShowModal(); 14 | Form1.Close; 15 | end; 16 | 17 | -------------------------------------------------------------------------------- /old/StatsD.dfm: -------------------------------------------------------------------------------- 1 | object FormStatsD: TFormStatsD 2 | Left = 0 3 | Top = 0 4 | Caption = 'FormStatsD' 5 | ClientHeight = 270 6 | ClientWidth = 301 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnShow = FormStatsDShow 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Label2: TLabel 18 | Left = 26 19 | Top = 33 20 | Width = 76 21 | Height = 13 22 | Caption = 'Number of Vias:' 23 | end 24 | object LabelNumOfVias: TLabel 25 | Left = 154 26 | Top = 33 27 | Width = 6 28 | Height = 13 29 | Caption = '0' 30 | end 31 | object Label1: TLabel 32 | Left = 26 33 | Top = 49 34 | Width = 122 35 | Height = 13 36 | Caption = 'Num. of Pads With Holes:' 37 | end 38 | object LabelNumOfPadsWithHoles: TLabel 39 | Left = 154 40 | Top = 49 41 | Width = 6 42 | Height = 13 43 | Caption = '0' 44 | end 45 | object Label3: TLabel 46 | Left = 26 47 | Top = 65 48 | Width = 111 49 | Height = 13 50 | Caption = 'Total num. of Holes:' 51 | Font.Charset = DEFAULT_CHARSET 52 | Font.Color = clWindowText 53 | Font.Height = -11 54 | Font.Name = 'Tahoma' 55 | Font.Style = [fsBold] 56 | ParentFont = False 57 | end 58 | object LabelTotalNumOfHoles: TLabel 59 | Left = 154 60 | Top = 65 61 | Width = 7 62 | Height = 13 63 | Caption = '0' 64 | Font.Charset = DEFAULT_CHARSET 65 | Font.Color = clWindowText 66 | Font.Height = -11 67 | Font.Name = 'Tahoma' 68 | Font.Style = [fsBold] 69 | ParentFont = False 70 | end 71 | object Label4: TLabel 72 | Left = 26 73 | Top = 129 74 | Width = 115 75 | Height = 13 76 | Caption = 'Min. Annular Ring (mm):' 77 | end 78 | object LabelMinAnnularRingMm: TLabel 79 | Left = 154 80 | Top = 129 81 | Width = 6 82 | Height = 13 83 | Caption = '0' 84 | end 85 | object Label5: TLabel 86 | Left = 26 87 | Top = 145 88 | Width = 111 89 | Height = 13 90 | Caption = 'Min. Track Width (mm):' 91 | end 92 | object LabelMinTrackWidthMm: TLabel 93 | Left = 154 94 | Top = 145 95 | Width = 6 96 | Height = 13 97 | Caption = '0' 98 | end 99 | object Label6: TLabel 100 | Left = 26 101 | Top = 161 102 | Width = 102 103 | Height = 13 104 | Caption = 'Num. Copper Layers:' 105 | end 106 | object LabelNumCopperLayers: TLabel 107 | Left = 154 108 | Top = 161 109 | Width = 6 110 | Height = 13 111 | Caption = '0' 112 | end 113 | object Label7: TLabel 114 | Left = 26 115 | Top = 193 116 | Width = 189 117 | Height = 13 118 | Caption = 'Board Width (bounding rectangle, mm):' 119 | end 120 | object Label8: TLabel 121 | Left = 26 122 | Top = 209 123 | Width = 192 124 | Height = 13 125 | Caption = 'Board Height (bounding rectangle, mm):' 126 | end 127 | object LabelBoardWidthMm: TLabel 128 | Left = 234 129 | Top = 193 130 | Width = 6 131 | Height = 13 132 | Caption = '0' 133 | end 134 | object LabelBoardHeightMm: TLabel 135 | Left = 234 136 | Top = 209 137 | Width = 6 138 | Height = 13 139 | Caption = '0' 140 | end 141 | object Label9: TLabel 142 | Left = 26 143 | Top = 97 144 | Width = 151 145 | Height = 13 146 | Caption = 'Number of Different Hole Sizes:' 147 | end 148 | object LabelNumDiffHoleSizes: TLabel 149 | Left = 186 150 | Top = 97 151 | Width = 6 152 | Height = 13 153 | Caption = '0' 154 | end 155 | object Label10: TLabel 156 | Left = 26 157 | Top = 225 158 | Width = 198 159 | Height = 13 160 | Caption = 'Board Area (bounding rectangle, mm^2):' 161 | end 162 | object LabelBoardAreaMm: TLabel 163 | Left = 234 164 | Top = 225 165 | Width = 6 166 | Height = 13 167 | Caption = '0' 168 | end 169 | end 170 | -------------------------------------------------------------------------------- /src/Checks/CheckComponentLinks.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file CheckComponentLinks.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-04-13 5 | ' @last-modified 2015-04-30 6 | ' @brief Script checks component links. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' @brief Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | ' @brief Name of this module. Used for debugging/warning/error message purposes. 14 | Private Const moduleName = "CheckComponentLinks.vbs" 15 | 16 | Sub CheckComponentLinks(DummyVar) 17 | 18 | Dim workspace 'As IWorkspace 19 | Dim pcbProject 'As IProject 20 | Dim document 'As IDocument 21 | Dim pcbBoard 'As IPCB_Board 22 | Dim pcbObject 'As IPCB_Primitive; 23 | Dim docNum 'As Integer 24 | 25 | StdOut("Checking component links...") 26 | 27 | ' Obtain the PCB server interface. 28 | If PCBServer Is Nothing Then 29 | StdErr("ERROR: PCB server not online." + VbCr + VbLf) 30 | StdOut(" Component links check complete." + vbCr + vbLf) 31 | Exit Sub 32 | End If 33 | 34 | ' Get pcb project interface 35 | Set workspace = GetWorkspace 36 | Set pcbProject = workspace.DM_FocusedProject 37 | 38 | IF pcbProject Is Nothing Then 39 | Call StdErr(ModuleName, "Current project is not a PCB project.") 40 | Call StdOut(" Component links check complete." + vbCr + vbLf) 41 | Exit Sub 42 | End If 43 | 44 | ' Loop through all project documents 45 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 46 | Set document = pcbProject.DM_LogicalDocuments(docNum) 47 | ' ShowMessage(document.DM_DocumentKind) 48 | ' If this is PCB document 49 | If document.DM_DocumentKind = "PCB" Then 50 | ' ShowMessage('PCB Found'); 51 | Set pcbBoard = PCBServer.GetPCBBoardByPath(document.DM_FullPath) 52 | Exit For 53 | End If 54 | Next 55 | 56 | If pcbBoard Is Nothing Then 57 | Call StdErr(ModuleName, "No PCB document found. Path used = " + document.DM_FullPath + ".") 58 | Call StdOut(" Component links check complete." + vbCr + vbLf) 59 | Exit Sub 60 | End If 61 | 62 | document.DM_LoadDocument() 63 | 64 | ' Check for component links 65 | ResetParameters 66 | Call AddStringParameter("ObjectKind", "Project") 67 | Call AddStringParameter("Action", "ComponentLinking") 68 | Call RunProcess("WorkspaceManager:DocumentOptions") 69 | 70 | ' Output 71 | StdOut(" Component links check complete." + vbCr + vbLf) 72 | 73 | End Sub 74 | 75 | 76 | -------------------------------------------------------------------------------- /src/Checks/CheckEmbeddedImages.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file CheckEmbeddedImages.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2015-08-05 5 | ' @last-modified 2015-08-05 6 | ' @brief Script that checks to make sure that all images on the schematics are embedded 7 | ' (so that they will be visible on other peoples computers that don't have the image file) 8 | ' @details 9 | ' See README.rst in repo root dir for more info. 10 | 11 | ' Forces us to explicitly define all variables before using them 12 | Option Explicit 13 | 14 | ' @brief The name of this module for logging purposes 15 | Private moduleName 16 | moduleName = "CheckEmbeddedImages.vbs" 17 | 18 | ' @brief Checks to make sure the tented via ratio of a PCB is above a certain limit. 19 | ' @param dummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 20 | Sub CheckEmbeddedImages(dummyVar) 21 | 22 | 23 | 24 | Dim docNum 'As Integer 25 | 26 | StdOut("Checking that all schematic images are embedded...") 27 | 28 | ' Obtain the schematic server interface. 29 | If SchServer Is Nothing Then 30 | Call StdErr(ModuleName, "Schematic server not online.") 31 | Exit Sub 32 | End If 33 | 34 | ' Get pcb project interface 35 | Dim workspace 'As IWorkspace 36 | Set workspace = GetWorkspace 37 | Dim pcbProject 'As IProject 38 | Set pcbProject = workspace.DM_FocusedProject 39 | 40 | If pcbProject Is Nothing Then 41 | Call StdErr(ModuleName, "Current Project is not a PCB Project") 42 | Exit Sub 43 | End If 44 | 45 | ' Compile project 46 | Dim flatHierarchy 47 | Set flatHierarchy = PCBProject.DM_DocumentFlattened 48 | 49 | ' If we couldn't get the flattened sheet, then most likely the project has 50 | ' not been compiled recently 51 | If flatHierarchy Is Nothing Then 52 | ' First try compiling the project 53 | ResetParameters 54 | Call AddStringParameter("Action", "Compile") 55 | Call AddStringParameter("ObjectKind", "Project") 56 | Call RunProcess("WorkspaceManager:Compile") 57 | 58 | ' Try Again to open the flattened document 59 | Set flatHierarchy = PCBProject.DM_DocumentFlattened 60 | If flatHierarchy Is Nothing Then 61 | Call StdErr(ModuleName, "Compile the project before running this script.") 62 | Exit Sub 63 | End If 64 | End If 65 | 66 | Dim numImages 67 | numImages = 0 68 | 69 | Dim violationCount 'As Integer 70 | violationCount = 0 71 | 72 | ' Loop through all project documents 73 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 74 | Dim document 'As IDocument 75 | Set document = pcbProject.DM_LogicalDocuments(docNum) 76 | 77 | ' If this is SCH document 78 | If document.DM_DocumentKind = "SCH" Then 79 | Dim sheet ' As ISch_Sheet 80 | Set sheet = SCHServer.GetSchDocumentByPath(document.DM_FullPath) 81 | 'ShowMessage(document.DM_FullPath); 82 | If sheet Is Nothing Then 83 | Call StdErr(moduleName, "No sheet found.") 84 | Exit Sub 85 | End If 86 | 87 | ' Set up iterator to look for power port objects only 88 | Dim iterator 89 | Set iterator = Sheet.SchIterator_Create 90 | If iterator Is Nothing Then 91 | Call StdErr(moduleName, "Iterator could not be created.") 92 | Exit Sub 93 | End If 94 | 95 | iterator.AddFilter_ObjectSet(MkSet(eImage)) 96 | 97 | Dim component ' As ISch_Component 98 | TLocation 99 | Set component = Iterator.FirstSchObject 100 | 101 | Do While Not (component Is Nothing) 102 | 103 | If Not component.EmbedImage Then 104 | violationCount = violationCount + 1 105 | ' It may seem like we need to divide by 10 here because Altium schematics seem to show the grid in centi-inches (100's of an inch), not mills. 106 | Call StdErr(moduleName, "ERROR: Non-embedded image violation found. Image on '" + _ 107 | document.DM_FileName + "' at x = '" + CStr(CoordToMils(component.Location.X)) + "mils', y = '" + CStr(CoordToMils(component.Location.Y)) + "mils'. ") 108 | End If 109 | 110 | numImages = numImages + 1 111 | 112 | Set component = iterator.NextSchObject 113 | Loop ' Do While Not (component Is Nothing) 114 | 115 | sheet.SchIterator_Destroy(iterator) 116 | 117 | End If ' If document.DM_DocumentKind = "SCH" Then 118 | 119 | Next ' For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 120 | 121 | If violationCount = 0 Then 122 | Call StdOut("No non-embedded image violations found. Total number of images found = '" + CStr(numImages) + "'. ") 123 | Else 124 | Call StdOut("ERROR: Non-embedded image violation found. Number of violations = '" + CStr(violationCount) + "', total num. of images = '" + CStr(numImages) + "'. ") 125 | End If 126 | 127 | Call StdOut("Non-embedded image checking finished." + VbCr + VbLf) 128 | 129 | End Sub 130 | -------------------------------------------------------------------------------- /src/Checks/CheckNameVersionDate.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file CheckNameVersionDate.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2015-01-13 6 | ' @brief Script checks the PCB for a valid name, version and date. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private ModuleName 14 | ModuleName = "CheckNameVersionDate.vbs" 15 | 16 | ' @brief Checks the PCB for a valid name, version and date. 17 | ' @param DummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 18 | Sub CheckNameVersionDate(DummyVar) 19 | 20 | StdOut("Checking PCB date...") 21 | 22 | Dim dateFound 'As Boolean 23 | Dim versionFound 'As Boolean 24 | versionFound = false 25 | dateFound = false 26 | 27 | ' Obtain the PCB server interface. 28 | If PCBServer Is Nothing Then 29 | Call StdErr(ModuleName, "PCB server not online.") 30 | StdOut("Date checker complete." + vbCr + vbLf) 31 | Exit Sub 32 | End If 33 | 34 | ' Get pcb project interface 35 | Dim workspace 'As IWorkspace 36 | Set workspace = GetWorkspace 37 | 38 | Dim pcbProject 'As IProject 39 | Set pcbProject = workspace.DM_FocusedProject 40 | 41 | If pcbProject Is Nothing Then 42 | Call StdErr(ModuleName, "Current Project is not a PCB project.") 43 | StdOut("Date checker complete." + vbCr + vbLf) 44 | Exit Sub 45 | End If 46 | 47 | ' Loop through all project documents 48 | Dim docNum 'As Integer 49 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 50 | Dim document 'As IDocument 51 | Set document = pcbProject.DM_LogicalDocuments(docNum) 52 | ' ShowMessage(document.DM_DocumentKind) 53 | ' If this is PCB document 54 | If document.DM_DocumentKind = "PCB" Then 55 | ' ShowMessage('PCB Found'); 56 | Dim pcbBoard 'As IPCB_Board 57 | Set pcbBoard = PCBServer.GetPCBBoardByPath(document.DM_FullPath) 58 | Exit For 59 | End If 60 | Next 61 | 62 | If pcbBoard Is Nothing Then 63 | Call StdErr(ModuleName, "No PCB document found. Path used = " + document.DM_FullPath + ".") 64 | StdOut("Date checker complete." + vbCr + vbLf) 65 | Exit Sub 66 | End If 67 | 68 | Dim pcbIterator 69 | 70 | ' Get iterator, limiting search to mech 1 layer 71 | Set pcbIterator = pcbBoard.BoardIterator_Create 72 | If pcbIterator Is Nothing Then 73 | Call StdErr(ModuleName, "PCB iterator could not be created.") 74 | StdOut("Date checker complete." + vbCr + vbLf) 75 | Exit Sub 76 | End If 77 | 78 | ' Look at strings 79 | pcbIterator.AddFilter_ObjectSet(MkSet(eTextObject)) 80 | pcbIterator.AddFilter_LayerSet(AllLayers) 81 | pcbIterator.AddFilter_Method(eProcessAll) 82 | 83 | ' Search and count pads 84 | Dim pcbObject 'As IPCB_Primitive; 85 | Set pcbObject = pcbIterator.FirstPCBObject 86 | While Not(pcbObject Is Nothing) 87 | ' Make sure that only tracks/arcs are present on this layer 88 | 'StdOut("Exp = " + IntToStr(pcbObject.Cache.SolderMaskExpansion) + ",") 89 | 'StdOut("Valid = " + IntToStr(pcbObject.Cache.SolderMaskExpansionValid) + ";") 90 | 91 | ' Project and version regex 92 | Dim reNameVersion 93 | Set reNameVersion = New RegExp 94 | reNameVersion.IgnoreCase = True 95 | reNameVersion.Global = True 96 | ' Look for date in pattern yyyy/mm/dd 97 | reNameVersion.Pattern = "v[0-9]*\.[0-9]*" 98 | 99 | If reNameVersion.Test(pcbObject.Text) Then 100 | 'StdOut("Version found!") 101 | versionFound = true 102 | End If 103 | 104 | ' Date regex 105 | Dim reDate 106 | Set reDate = New RegExp 107 | reDate.IgnoreCase = True 108 | reDate.Global = True 109 | ' Look for date in pattern yyyy/mm/dd or yyyy-mm-dd 110 | reDate.Pattern = "[0-9][0-9][0-9][0-9][/-][0-9][0-9][/-][0-9][0-9]" 111 | 112 | If reDate.Test(pcbObject.Text) Then 113 | 'StdOut("Date found!") 114 | dateFound = true 115 | End If 116 | 117 | Set pcbObject = pcbIterator.NextPCBObject 118 | WEnd 119 | 120 | pcbBoard.BoardIterator_Destroy(pcbIterator) 121 | 122 | 123 | If Not DateFound Then 124 | Call StdErr(ModuleName, "Date not found violation. Please add the date to the PCB in the format yyyy/mm/dd.") 125 | Else 126 | Stdout("Date found. ") 127 | End If 128 | 129 | If Not VersionFound Then 130 | Call StdErr(ModuleName, "Version not found violation. Please add the version to the PCB in the format v[0-9]*\.[0-9]*") 131 | Else 132 | StdOut("Verison found. ") 133 | End If 134 | 135 | ' Output 136 | StdOut("Date checker complete." + vbCr + vbLf) 137 | 138 | End Sub 139 | 140 | 141 | -------------------------------------------------------------------------------- /src/Checks/CheckNoSupplierPartNumShown.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file CheckNoSupplierPartNumShown.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2014-12-22 6 | ' @brief Checks that no supplier part numbers are shown on the schematics (you should show manufacturing part numbers!) 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private ModuleName 14 | ModuleName = "CheckNoSupplierPartNumShown.vbs" 15 | 16 | ' @param DummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 17 | Sub CheckNoSupplierPartNumShown(DummyVar) ' As TMemo 18 | Dim Workspace ' As IWorkspace 19 | Dim PcbProject ' As IProject 20 | Dim Document ' As IDocument 21 | Dim FlatHierarchy ' As IDocument 22 | Dim Sheet ' As ISch_Document 23 | Dim DocNum ' As Integer 24 | Dim Iterator ' As ISch_Iterator 25 | Dim CompIterator ' As ISch_Iterator 26 | Dim Component ' As IComponent 27 | Dim Parameter, Parameter2 ' As ISch_Parameter 28 | Dim ViolationCount ' As Integer 29 | 30 | Call StdOut("Looking for visible supplier part numbers...") 31 | 32 | ViolationCount = 0 33 | 34 | ' Obtain the schematic server interface. 35 | If SchServer Is Nothing Then 36 | Call StdErr(ModuleName, "Schematic server not online.") 37 | Exit Sub 38 | End If 39 | 40 | ' Get pcb project interface 41 | Set workspace = GetWorkspace 42 | Set pcbProject = workspace.DM_FocusedProject 43 | 44 | If pcbProject Is Nothing Then 45 | Call StdErr(ModuleName, "Current Project is not a PCB Project") 46 | Exit Sub 47 | End If 48 | 49 | ' Compile project 50 | Set flatHierarchy = PCBProject.DM_DocumentFlattened 51 | 52 | ' If we couldn't get the flattened sheet, then most likely the project has 53 | ' not been compiled recently 54 | If flatHierarchy Is Nothing Then 55 | ' First try compiling the project 56 | ResetParameters 57 | Call AddStringParameter("Action", "Compile") 58 | Call AddStringParameter("ObjectKind", "Project") 59 | Call RunProcess("WorkspaceManager:Compile") 60 | 61 | ' Try Again to open the flattened document 62 | Set flatHierarchy = PCBProject.DM_DocumentFlattened 63 | If flatHierarchy Is Nothing Then 64 | Call StdErr(ModuleName, "Compile the project before running this script.") 65 | Exit Sub 66 | End If 67 | End If 68 | 69 | ' Loop through all project documents 70 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 71 | Set document = pcbProject.DM_LogicalDocuments(docNum) 72 | 73 | ' If this is SCH document 74 | If document.DM_DocumentKind = "SCH" Then 75 | Set sheet = SCHServer.GetSchDocumentByPath(document.DM_FullPath) 76 | 'ShowMessage(document.DM_FullPath); 77 | If sheet Is Nothing Then 78 | Call StdErr(ModuleName, "No sheet found.") 79 | Exit Sub 80 | End If 81 | 82 | ' Set up iterator to look for power port objects only 83 | Set Iterator = Sheet.SchIterator_Create 84 | If Iterator Is Nothing Then 85 | Call StdErr(ModuleName, "Iterator could not be created.") 86 | Exit Sub 87 | End If 88 | 89 | iterator.AddFilter_ObjectSet(MkSet(eSchComponent)) 90 | Set component = Iterator.FirstSchObject 91 | Do While Not (component Is Nothing) 92 | compIterator = component.SchIterator_Create 93 | compIterator.AddFilter_ObjectSet(MkSet(eParameter)) 94 | 95 | Set parameter = compIterator.FirstSchObject 96 | ' Loop through all parameters in object 97 | Do While Not (parameter Is Nothing) 98 | ' Check for supplier part number parameter thats visible on sheet 99 | If(parameter.Name = "Supplier Part Number 1") and (parameter.IsHidden = false) Then 100 | violationCount = violationCount + 1 101 | Call StdErr(ModuleName, "Supplier part num violation '" + parameter.Text + "' in component '" + component.Designator.Text + "'.") 102 | End If 103 | 104 | 'if ((AnsiUpperCase(Parameter.Name) = 'GROUP') and (Parameter.Text <> '') and (Parameter.Text <> '*')) then 105 | ' if StrToInt(Parameter.Text) > MaxNumber then 106 | ' MaxNumber := StrToInt(Parameter.Text); 107 | 108 | Set parameter = CompIterator.NextSchObject 109 | Loop 110 | 111 | component.SchIterator_Destroy(compIterator) 112 | Set component = iterator.NextSchObject 113 | Loop 114 | 115 | sheet.SchIterator_Destroy(iterator) 116 | 117 | End If ' If document.DM_DocumentKind = "SCH" Then 118 | 119 | Next ' For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 120 | 121 | If violationCount = 0 Then 122 | Call StdOut("No supplier part number violations found. ") 123 | Else 124 | Call StdOut("ERROR: Supplier part number visible on sheet violation found. Number of violations = '" + IntToStr(violationCount) + "'. ") 125 | End If 126 | 127 | Call StdOut("Supplier part number checking finished." + VbCr + VbLf) 128 | End Sub 129 | -------------------------------------------------------------------------------- /src/Checks/CheckPcbCompDesignatorRotation.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file CheckPcbCompDesignatorRotation.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2015-04-30 5 | ' @last-modified 2015-04-30 6 | ' @brief Checks that PCB designators are only rotated in two of the possible four directions 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | ' @brief Name of this module. Used for debugging/warning/error message purposes and for 14 | ' saving user data. 15 | Private Const moduleName = "CheckPcbCompDesignatorRotation.vbs" 16 | 17 | ' @brief Checks that PCB text has the correct orientation (top-layer text not mirrored, 18 | ' bottom layer text mirrored). 19 | ' @param dummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 20 | Sub CheckPcbCompDesignatorRotation(dummyVar) 21 | 22 | StdOut("Checking PCB designator rotation...") 23 | 24 | Dim violationCount 'As Integer 25 | violationCount = 0 26 | 27 | ' Obtain the PCB server interface. 28 | If PCBServer Is Nothing Then 29 | Call StdErr(moduleName, "PCB server not online.") 30 | StdOut("PCB designator rotation check complete." + vbCr + vbLf) 31 | Exit Sub 32 | End If 33 | 34 | ' Get pcb project interface 35 | Dim workspace 'As IWorkspace 36 | Set workspace = GetWorkspace 37 | 38 | Dim pcbProject 'As IProject 39 | Set pcbProject = workspace.DM_FocusedProject 40 | 41 | If pcbProject Is Nothing Then 42 | Call StdErr(moduleName, "Current project is not a PCB project.") 43 | StdOut("PCB designator rotation check complete." + vbCr + vbLf) 44 | Exit Sub 45 | End If 46 | 47 | ' Loop through all project documents 48 | Dim docNum 'As Integer 49 | Dim pcbBoard 'As IPCB_Board 50 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 51 | Dim document 'As IDocument 52 | Set document = pcbProject.DM_LogicalDocuments(docNum) 53 | ' ShowMessage(document.DM_DocumentKind) 54 | ' If this is PCB document 55 | If document.DM_DocumentKind = "PCB" Then 56 | ' ShowMessage('PCB Found'); 57 | Set pcbBoard = PCBServer.GetPCBBoardByPath(document.DM_FullPath) 58 | Exit For 59 | End If 60 | Next 61 | 62 | If pcbBoard Is Nothing Then 63 | Call StdErr(moduleName, "No PCB document found. Path used = " + document.DM_FullPath + ".") 64 | StdOut("PCB designator rotation check complete." + vbCr + vbLf) 65 | Exit Sub 66 | End If 67 | 68 | Dim pcbIterator 69 | 70 | ' Get iterator 71 | Set pcbIterator = pcbBoard.BoardIterator_Create 72 | If pcbIterator Is Nothing Then 73 | Call StdErr(moduleName, "PCB iterator could not be created.") 74 | StdOut("PCB designator rotation check complete." + vbCr + vbLf) 75 | Exit Sub 76 | End If 77 | 78 | ' Look at the rotation of designators on top and bottom layers separately 79 | Dim x 80 | For x = 0 To 1 81 | pcbIterator.AddFilter_ObjectSet(MkSet(eComponentObject)) 82 | pcbIterator.AddFilter_LayerSet(AllLayers) 83 | pcbIterator.AddFilter_Method(eProcessAll) 84 | 85 | Dim zeroDegRotation 86 | zeroDegRotation = False 87 | Dim nintyDegRotation 88 | nintyDegRotation = False 89 | Dim oneEightyDegRotation 90 | oneEightyDegRotation = False 91 | Dim twoSeventyDegRotation 92 | twoSeventyDegRotation = False 93 | 94 | Dim firstWarning1 95 | firstWarning1 = False 96 | Dim firstWarning2 97 | firstWarning2 = False 98 | 99 | ' Iterate through all found strings 100 | Dim pcbObject 101 | Set pcbObject = pcbIterator.FirstPCBObject 102 | While Not(pcbObject Is Nothing) 103 | ' Make sure that only tracks/arcs are present on this layer 104 | 'StdOut("Exp = " + IntToStr(pcbObject.Cache.SolderMaskExpansion) + ",") 105 | 'StdOut("Valid = " + IntToStr(pcbObject.Cache.SolderMaskExpansionValid) + ";") 106 | 107 | ' Get the designator 108 | Dim compDesignator ' As IPCB_Text 109 | Set compDesignator = pcbObject.Name 110 | 111 | 'ShowMessage("Rotation = '" + FloatToStr(compDesignator.Rotation) + "'.") 112 | 113 | If (x = 0 And compDesignator.Layer = eTopOverlay) Or (x = 1 And compDesignator.Layer = eBottomOverlay) Then 114 | If compDesignator.Rotation = 0 Then 115 | zeroDegRotation = True 116 | ElseIf compDesignator.Rotation = 90 Then 117 | nintyDegRotation = True 118 | ElseIf compDesignator.Rotation = 180 Then 119 | oneEightyDegRotation = True 120 | ElseIf compDesignator.Rotation = 270 Then 121 | twoSeventyDegRotation = True 122 | End If 123 | 124 | If zeroDegRotation And oneEightyDegRotation Then 125 | If firstWarning1 = False Then 126 | If compDesignator.Layer = eTopOverlay Then 127 | Call StdErr(moduleName, "Component designators have both 0 and 180 degree rotation on top silkscreen.") 128 | ElseIf compDesignator.Layer = eBottomOverlay Then 129 | Call StdErr(moduleName, "Component designators have both 0 and 180 degree rotation on bottom silkscreen.") 130 | End If 131 | violationCount = violationCount + 1 132 | firstWarning1 = True 133 | End If 134 | End If 135 | 136 | If nintyDegRotation And twoSeventyDegRotation Then 137 | If firstWarning2 = False Then 138 | If compDesignator.Layer = eTopOverlay Then 139 | Call StdErr(moduleName, "Component designators have both 90 and 270 degree rotation on top silkscreen.") 140 | ElseIf compDesignator.Layer = eBottomOverlay Then 141 | Call StdErr(moduleName, "Component designators have both 90 and 270 degree rotation on bottom silkscreen.") 142 | End If 143 | violationCount = violationCount + 1 144 | firstWarning2 = True 145 | End If 146 | End If 147 | End If 148 | 149 | Set pcbObject = pcbIterator.NextPCBObject 150 | WEnd 151 | Next 152 | 153 | pcbBoard.BoardIterator_Destroy(pcbIterator) 154 | 155 | ' If violations then print to StdOut 156 | If Not violationCount = 0 Then 157 | StdOut("ERROR: PCB component designator rotation violation(s) found. Please make sure designators are rotated in two directions only. Num. violations = " + IntToStr(violationCount) + ". ") 158 | End If 159 | 160 | ' Output 161 | StdOut("PCB designator rotation check complete." + vbCr + vbLf) 162 | 163 | End Sub 164 | 165 | 166 | -------------------------------------------------------------------------------- /src/Checks/CheckPcbCompPrimitivesLocked.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file CheckPcbCompPrimitivesLocked.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2015-08-06 5 | ' @last-modified 2015-08-06 6 | ' @brief Checks to make sure all PCB component primitives are locked. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | ' @brief Name of this module. Used for debugging/warning/error message purposes and for 14 | ' saving user data. 15 | Private Const moduleName = "CheckPcbCompPrimitivesLocked.vbs" 16 | 17 | ' @brief Checks to make sure all PCB component primitives are locked 18 | ' @param dummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 19 | Sub CheckPcbCompPrimitivesLocked(dummyVar) 20 | 21 | StdOut("Making sure all PCB component primitives are locked...") 22 | 23 | Dim violationCount 'As Integer 24 | violationCount = 0 25 | 26 | ' Obtain the PCB server interface. 27 | If PCBServer Is Nothing Then 28 | Call StdErr(moduleName, "PCB server not online.") 29 | StdOut("PCB designator rotation check complete." + vbCr + vbLf) 30 | Exit Sub 31 | End If 32 | 33 | ' Get pcb project interface 34 | Dim workspace 'As IWorkspace 35 | Set workspace = GetWorkspace 36 | 37 | Dim pcbProject 'As IProject 38 | Set pcbProject = workspace.DM_FocusedProject 39 | 40 | If pcbProject Is Nothing Then 41 | Call StdErr(moduleName, "Current project is not a PCB project.") 42 | StdOut("PCB designator rotation check complete." + vbCr + vbLf) 43 | Exit Sub 44 | End If 45 | 46 | ' Loop through all project documents 47 | Dim docNum 'As Integer 48 | Dim pcbBoard 'As IPCB_Board 49 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 50 | Dim document 'As IDocument 51 | Set document = pcbProject.DM_LogicalDocuments(docNum) 52 | ' ShowMessage(document.DM_DocumentKind) 53 | ' If this is PCB document 54 | If document.DM_DocumentKind = "PCB" Then 55 | ' ShowMessage('PCB Found'); 56 | Set pcbBoard = PCBServer.GetPCBBoardByPath(document.DM_FullPath) 57 | Exit For 58 | End If 59 | Next 60 | 61 | If pcbBoard Is Nothing Then 62 | Call StdErr(moduleName, "No PCB document found. Path used = " + document.DM_FullPath + ".") 63 | StdOut("PCB designator rotation check complete." + vbCr + vbLf) 64 | Exit Sub 65 | End If 66 | 67 | Dim pcbIterator 68 | 69 | ' Get iterator 70 | Set pcbIterator = pcbBoard.BoardIterator_Create 71 | If pcbIterator Is Nothing Then 72 | Call StdErr(moduleName, "PCB iterator could not be created.") 73 | StdOut("PCB designator rotation check complete." + vbCr + vbLf) 74 | Exit Sub 75 | End If 76 | 77 | ' Look at the rotation of designators on top and bottom layers separately 78 | 79 | pcbIterator.AddFilter_ObjectSet(MkSet(eComponentObject)) 80 | pcbIterator.AddFilter_LayerSet(AllLayers) 81 | pcbIterator.AddFilter_Method(eProcessAll) 82 | 83 | ' Iterate through all found strings 84 | Dim pcbComponent ' As IPCB_Component 85 | Set pcbComponent = pcbIterator.FirstPCBObject 86 | While Not(pcbComponent Is Nothing) 87 | 88 | ' Check for unlocked primitives 89 | If Not pcbComponent.PrimitiveLock Then 90 | Call StdErr(moduleName, "Component '" + pcbComponent.Name + "' has unlocked primitives.") 91 | violationCount = violationCount + 1 92 | End If 93 | 94 | Set pcbComponent = pcbIterator.NextPCBObject 95 | WEnd ' While Not(pcbObject Is Nothing) 96 | 97 | pcbBoard.BoardIterator_Destroy(pcbIterator) 98 | 99 | ' If violations then print to StdOut 100 | If Not violationCount = 0 Then 101 | StdOut("ERROR: PCB components with unlocked primitives found. Num. violations = '" + CStr(violationCount) + "'. ") 102 | End If 103 | 104 | ' Output 105 | StdOut("PCB component primitive check complete." + vbCr + vbLf) 106 | 107 | End Sub 108 | 109 | 110 | -------------------------------------------------------------------------------- /src/Checks/CheckPcbTextHasCorrectOrientation.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file CheckPcbTextHasCorrectOrientation.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2015-01-14 6 | ' @brief Checks that PCB text has the correct orientation (top-layer text not mirrored, 7 | ' bottom layer text mirrored). 8 | ' @details 9 | ' See README.rst in repo root dir for more info. 10 | 11 | ' Forces us to explicitly define all variables before using them 12 | Option Explicit 13 | 14 | Private ModuleName 15 | ModuleName = "CheckPcbTextHasCorrectOrientation.vbs" 16 | 17 | ' @brief Checks that PCB text has the correct orientation (top-layer text not mirrored, 18 | ' bottom layer text mirrored). 19 | ' @param DummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 20 | Sub CheckPcbTextHasCorrectOrientation(DummyVar) 21 | 22 | StdOut("Checking PCB text has correct orientation...") 23 | 24 | Dim violationCount 'As Integer 25 | ViolationCount = 0 26 | 27 | ' Obtain the PCB server interface. 28 | If PCBServer Is Nothing Then 29 | Call StdErr(ModuleName, "PCB server not online.") 30 | StdOut("PCB text orientation check complete." + vbCr + vbLf) 31 | Exit Sub 32 | End If 33 | 34 | ' Get pcb project interface 35 | Dim workspace 'As IWorkspace 36 | Set workspace = GetWorkspace 37 | 38 | Dim pcbProject 'As IProject 39 | Set pcbProject = workspace.DM_FocusedProject 40 | 41 | If pcbProject Is Nothing Then 42 | Call StdErr(ModuleName, "Current project is not a PCB project.") 43 | StdOut("PCB text orientation check complete." + vbCr + vbLf) 44 | Exit Sub 45 | End If 46 | 47 | ' Loop through all project documents 48 | Dim docNum 'As Integer 49 | Dim pcbBoard 'As IPCB_Board 50 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 51 | Dim document 'As IDocument 52 | Set document = pcbProject.DM_LogicalDocuments(docNum) 53 | ' ShowMessage(document.DM_DocumentKind) 54 | ' If this is PCB document 55 | If document.DM_DocumentKind = "PCB" Then 56 | ' ShowMessage('PCB Found'); 57 | Set pcbBoard = PCBServer.GetPCBBoardByPath(document.DM_FullPath) 58 | Exit For 59 | End If 60 | Next 61 | 62 | If pcbBoard Is Nothing Then 63 | Call StdErr(ModuleName, "No PCB document found. Path used = " + document.DM_FullPath + ".") 64 | StdOut("PCB text orientation check complete." + vbCr + vbLf) 65 | Exit Sub 66 | End If 67 | 68 | Dim pcbIterator 69 | 70 | ' Get iterator, limiting search to mech 1 layer 71 | Set pcbIterator = pcbBoard.BoardIterator_Create 72 | If pcbIterator Is Nothing Then 73 | Call StdErr(ModuleName, "PCB iterator could not be created.") 74 | StdOut("PCB text orientation check complete." + vbCr + vbLf) 75 | Exit Sub 76 | End If 77 | 78 | ' Look at strings 79 | pcbIterator.AddFilter_ObjectSet(MkSet(eTextObject)) 80 | pcbIterator.AddFilter_LayerSet(AllLayers) 81 | pcbIterator.AddFilter_Method(eProcessAll) 82 | 83 | ' Iterate through all found strings 84 | Dim pcbObject 'As IPCB_Primitive; 85 | Set pcbObject = pcbIterator.FirstPCBObject 86 | While Not(pcbObject Is Nothing) 87 | ' Make sure that only tracks/arcs are present on this layer 88 | 'StdOut("Exp = " + IntToStr(pcbObject.Cache.SolderMaskExpansion) + ",") 89 | 'StdOut("Valid = " + IntToStr(pcbObject.Cache.SolderMaskExpansionValid) + ";") 90 | If(pcbObject.Layer = eTopOverlay) And (pcbObject.MirrorFlag = true) Then 91 | violationCount = violationCount + 1 92 | Call StdErr(ModuleName, "PCB text '" + pcbObject.Text + "' on the top overlay is mirrored.") 93 | End If 94 | 95 | If(pcbObject.Layer = eBottomOverlay) And (pcbObject.MirrorFlag = false) Then 96 | violationCount = violationCount + 1 97 | Call StdErr(ModuleName, "PCB text '" + pcbObject.Text + "' on the bottom overlay is not mirrored.") 98 | End If 99 | 100 | Set pcbObject = pcbIterator.NextPCBObject 101 | WEnd 102 | 103 | pcbBoard.BoardIterator_Destroy(pcbIterator) 104 | 105 | ' If violations then print to StdErr 106 | If Not ViolationCount = 0 Then 107 | StdOut("ERROR: PCB text orientation violation(s) found. Please make sure text on the top layer is not mirrored, and text on the bottom layer is mirrored. Num. violations = " + IntToStr(violationCount) + ".") 108 | End If 109 | 110 | ' Output 111 | StdOut(" PCB text orientation check complete." + vbCr + vbLf) 112 | 113 | End Sub 114 | 115 | 116 | -------------------------------------------------------------------------------- /src/Checks/CheckProjectCompiles.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file CheckProjectCompiles.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2015-01-15 6 | ' @brief Script that checks to make sure the current project compiles successfully. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private moduleName 14 | moduleName = "CheckProjectCompiles.vbs" 15 | 16 | ' @brief This makes sure the project is compiled. 17 | ' @details Note that this does not check to see whether the project compiles without errors, this 18 | ' will still return True if it compiles with errors. 19 | ' @param DummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 20 | Function CheckProjectCompiles(DummyVar) 21 | 22 | StdOut("Checking project compiles...") 23 | 24 | Dim violationFnd 25 | violationFnd = false 26 | 27 | ' Obtain the schematic server interface. 28 | If SchServer Is Nothing Then 29 | ' Maybe we could use this in the future... 30 | ' Client.StartServer("SCH") 31 | 32 | Call StdErr(moduleName, "Schematic server not online.") 33 | CheckProjectCompiles = False 34 | Exit Function 35 | End If 36 | 37 | ' Get pcb project interface 38 | Dim workspace ' As IWorkspace 39 | Set workspace = GetWorkspace 40 | 41 | Dim pcbProject ' As IProject 42 | Set pcbProject = workspace.DM_FocusedProject 43 | 44 | If pcbProject Is Nothing Then 45 | Call StdErr(moduleName, "Current project is not a PCB project.") 46 | CheckProjectCompiles = False 47 | Exit Function 48 | End If 49 | 50 | ' Compile project 51 | Dim flatHierarchy ' As IDocument 52 | Set flatHierarchy = PCBProject.DM_DocumentFlattened 53 | 54 | ' If we couldn't get the flattened sheet, then most likely the project has 55 | ' not been compiled recently 56 | If flatHierarchy Is Nothing Then 57 | ' First try compiling the project 58 | ResetParameters 59 | Call AddStringParameter("Action", "Compile") 60 | Call AddStringParameter("ObjectKind", "Project") 61 | Call RunProcess("WorkspaceManager:Compile") 62 | 63 | ' Try Again to open the flattened document 64 | Set flatHierarchy = PCBProject.DM_DocumentFlattened 65 | If flatHierarchy Is Nothing Then 66 | Call StdErr(moduleName, "Could not compile project.") 67 | CheckProjectCompiles = False 68 | Exit Function 69 | End If 70 | End If 71 | 72 | ' If code reaches here, compilation was successful 73 | StdOut("Compilation successful." + VbCr + VbLf) 74 | CheckProjectCompiles = True 75 | End Function 76 | -------------------------------------------------------------------------------- /src/Checks/CheckTentedVias.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file CheckTentedVias.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2015-08-05 6 | ' @brief Script that checks to make sure that most vias are tented on the PCB. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | ' @brief The name of this module for logging purposes 14 | Private moduleName 15 | moduleName = "CheckTentedVias.vbs" 16 | 17 | ' @brief Checks to make sure the tented via ratio of a PCB is above a certain limit. 18 | ' @param dummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 19 | Sub CheckTentedVias(dummyVar) 20 | Dim workspace 'As IWorkspace 21 | Dim pcbProject 'As IProject 22 | Dim document 'As IDocument 23 | Dim violationCnt 'As Integer 24 | Dim pcbBoard 'As IPCB_Board 25 | Dim pcbObject 'As IPCB_Primitive; 26 | Dim docNum 'As Integer 27 | Dim tentedViaCount 'As Integer 28 | Dim nonTentedViaCount 'As Integer 29 | Dim pcbIterator 30 | Dim tentedViaRatio 31 | 32 | ' Zero count variables 33 | tentedViaCount = 0 34 | nonTentedViaCount = 0 35 | 36 | StdOut("Checking tented vias...") 37 | violationCnt = 0 38 | 39 | ' Obtain the PCB server interface. 40 | If PCBServer Is Nothing Then 41 | Call StdErr(moduleName, "PCB server not online.") 42 | StdOut("Tented via checking finished." + VbCr + VbLf) 43 | Exit Sub 44 | End If 45 | 46 | ' Get pcb project interface 47 | Set workspace = GetWorkspace 48 | Set pcbProject = Workspace.DM_FocusedProject 49 | 50 | If pcbProject Is Nothing Then 51 | Call StdErr(moduleName, "Current Project is not a PCB Project.") 52 | StdOut("Tented via checking finished." + VbCr + VbLf) 53 | Exit Sub 54 | End If 55 | 56 | ' Loop through all project documents 57 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 58 | Set document = pcbProject.DM_LogicalDocuments(docNum) 59 | ' ShowMessage(document.DM_DocumentKind) 60 | ' If this is PCB document 61 | If document.DM_DocumentKind = "PCB" Then 62 | ' ShowMessage('PCB Found'); 63 | Set pcbBoard = PCBServer.GetPCBBoardByPath(document.DM_FullPath) 64 | Exit For 65 | End If 66 | Next 67 | 68 | ' Should this be gotten from the pcbProject, not the PCB server (so it doesn't have to 69 | ' be open to work) 70 | 'pcbBoard := pcbProject.DM_TopLevelPhysicalDocument; 71 | 72 | If pcbBoard Is Nothing Then 73 | Call StdErr(moduleName, "No PCB document found. Path used = " + document.DM_FullPath + ".") 74 | StdOut("Tented via checking finished." + VbCr + VbLf) 75 | Exit Sub 76 | End If 77 | 78 | ' Get iterator, limiting search to mech 1 layer 79 | Set pcbIterator = pcbBoard.BoardIterator_Create 80 | If pcbIterator Is Nothing Then 81 | Call StdErr(moduleName, "PCB iterator could not be created.") 82 | StdOut("Tented via checking finished." + VbCr + VbLf) 83 | Exit Sub 84 | End If 85 | 86 | pcbIterator.AddFilter_ObjectSet(MkSet(eViaObject)) 87 | pcbIterator.AddFilter_LayerSet(AllLayers) 88 | pcbIterator.AddFilter_Method(eProcessAll) 89 | 90 | ' Keeps track of how many via surfaces are not applicable to tented (i.e. all 91 | ' internal surfaces of buried or blind vias) 92 | Dim numNotApplicableSurfaces 93 | 94 | ' Search and count pads 95 | Set pcbObject = pcbIterator.FirstPCBObject 96 | While Not(pcbObject Is Nothing) 97 | 98 | ' NEW METHOD (2015-08-05) 99 | 100 | ' This method treats the top and bottom surfaces of the via separately 101 | 102 | 'ShowMessage("via.X = " + CStr(CoordToMMs(pcbObject.x - pcbBoard.XOrigin)) + ", via.y = " + CStr(CoordToMMs(pcbObject.y - pcbBoard.YOrigin)) + ", via.IsTentingTop = " + BoolToStr(pcbObject.GetState_IsTenting_Top) + ", via.IsTentingBottom = " + BoolToStr(pcbObject.GetState_IsTenting_Bottom)) 103 | 104 | If pcbObject.StartLayer.LayerId = eTopLayer Then 105 | If (pcbObject.GetState_IsTenting_Top = True) Then 106 | ' Via surface is tented 107 | tentedViaCount = tentedViaCount + 1 108 | Else 109 | ' Via surface is not tented 110 | nonTentedViaCount = nonTentedViaCount + 1 111 | End If 112 | Else 113 | numNotApplicableSurfaces = numNotApplicableSurfaces + 1 114 | End If 115 | 116 | If pcbObject.StartLayer.LayerId = eBottomLayer Then 117 | If (pcbObject.GetState_IsTenting_Bottom = True) Then 118 | ' Via surface is tented 119 | tentedViaCount = tentedViaCount + 1 120 | Else 121 | ' Via surface is not tented 122 | nonTentedViaCount = nonTentedViaCount + 1 123 | End If 124 | Else 125 | numNotApplicableSurfaces = numNotApplicableSurfaces + 1 126 | End If 127 | 128 | ' NEW METHOD (2014-12-22) 129 | 130 | 'Via.SetState_IsTenting_Top(False); 131 | 'Via.SetState_IsTenting_Bottom(False); 132 | 'If pcbObject.StartLayer.LayerId = eTopLayer And (pcbObject.GetState_IsTenting_Top = False) Then 133 | 134 | 135 | 'If And (pcbObject.GetState_IsTenting_Bottom = True) Then 136 | ' Via is tented (on both sides) 137 | ' tentedViaCount = tentedViaCount + 1 138 | 'Else 139 | ' Via is not tented (on one or both sides) 140 | ' nonTentedViaCount = nonTentedViaCount + 1 141 | 'End If 142 | 143 | 'Via.SetState_IsTenting_Bottom(False); 144 | 145 | ' OLD METHOD 146 | 147 | ' This was the other way of tenting vias, by adding a rule instead 148 | ' of selecting "Force complete tenting on top/bottom" in Via properties. 149 | 'If PcbObject.Cache.SolderMaskExpansion*2 <= -PcbObject.Size Then 150 | ' ' Via is tented (both sides) 151 | ' TentedViaCount = TentedViaCount + 1 152 | 'Else 153 | ' ' Via is not tented (on both sides) 154 | ' NonTentedViaCount = NonTentedViaCount + 1 155 | 'End If 156 | 157 | Set pcbObject = pcbIterator.NextPCBObject 158 | WEnd 159 | 160 | pcbBoard.BoardIterator_Destroy(pcbIterator) 161 | 162 | 'StdOut("Num. tented vias = " + IntToStr(tentedViaCount) + "." + vbCr + vbLf) 163 | 'StdOut("Num. non-tented vias = " + IntToStr(nonTentedViaCount) + "." + vbCr + vbLf) 164 | 165 | ' Calc percentage 166 | If tentedViaCount + nonTentedViaCount = 0 Then 167 | ' This would could divide by 0 error, so let's set this to 1 168 | tentedViaRatio = 1 169 | Else 170 | ' Denominator is not 0, so safe to divide 171 | tentedViaRatio = tentedViaCount / (tentedViaCount + nonTentedViaCount) 172 | End If 173 | 174 | ' Output 175 | StdOut("Tented via surface ratio = " + FormatNumber(tentedViaRatio) + ". Number of exposed via surfaces found = " + IntToStr(tentedViaCount + nonTentedViaCount) + ". Tented via check complete." + vbCr + vbLf) 176 | 177 | If(tentedViaRatio < MIN_TENTED_VIA_RATIO) Then 178 | Call StdErr(moduleName, "Tented via surface ratio violation found (ratio = " + FormatNumber(tentedViaRatio) + ", minimum allowed ratio = " + FormatNumber(MIN_TENTED_VIA_RATIO) + "). Number of violating via surfaces = " + IntToStr(nonTentedViaCount) + ". Have you forgotten to tent vias?") 179 | End If 180 | 181 | End Sub 182 | -------------------------------------------------------------------------------- /src/Checks/CheckWeHavePcbDocAccess.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file CheckWeHavePcbDocAccess.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2014-11-04 5 | ' @last-modified 2015-06-10 6 | ' @brief Script that checks to make sure we have access to a PCB document belonging to the current project. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private moduleName 14 | moduleName = "CheckWeHavePcbDocAccess.vbs" 15 | 16 | ' @brief Checks to make sure we have access to a PCB document belonging to the current project. 17 | ' @details 18 | ' @param DummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 19 | ' @returns Returns True if we have access, otherwise false. 20 | Function CheckWeHavePcbDocAccess(DummyVar) 21 | 22 | StdOut("Checking we have PCB access...") 23 | 24 | ' Obtain the PCB server interface. 25 | Client.StartServer("PCB") 26 | If PCBServer Is Nothing Then 27 | Call StdErr(moduleName, "PCB server not online and could not be started.") 28 | Exit Function 29 | End If 30 | 31 | ' Get pcb project interface 32 | Dim workspace 33 | Set workspace = GetWorkspace 34 | 35 | Dim pcbProject 36 | Set pcbProject = workspace.DM_FocusedProject 37 | 38 | If pcbProject Is Nothing Then 39 | Call StdErr(moduleName, "Current project is not a PCB project.") 40 | Exit Function 41 | End If 42 | 43 | Dim docNum 44 | Dim document 45 | Dim pcbDocument 46 | Dim pcbBoard 47 | 48 | ' Loop through all project documents 49 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 50 | Set document = pcbProject.DM_LogicalDocuments(DocNum) 51 | ' ShowMessage(document.DM_DocumentKind) 52 | ' If this is PCB document 53 | If document.DM_DocumentKind = "PCB" Then 54 | ' ShowMessage('PCB Found'); 55 | 56 | ' Open the PCB document, so we can then can a handle for it 57 | pcbDocument = Client.OpenDocument("PCB", document.DM_FullPath) 58 | ' Try a get the current PCB file, this will only work if 59 | ' it is open 60 | Set pcbBoard = PCBServer.GetPCBBoardByPath(document.DM_FullPath) 61 | Exit For 62 | End If 63 | Next 64 | 65 | 'ShowMessage("test") 66 | If IsEmpty(pcbBoard) Then 67 | Call StdErr(moduleName, "Could not get access to PcbDoc file. Please make sure PCB file is open and run checks again.") 68 | CheckWeHavePcbDocAccess = False 69 | StdOut(" PCB access checking complete." + VbCr + VbLf) 70 | Exit Function 71 | End If 72 | 73 | ' If code reaches here, compilation was successful 74 | StdOut("We have PCB access.") 75 | StdOut(" PCB access checking complete." + VbCr + VbLf) 76 | CheckWeHavePcbDocAccess = True 77 | End Function 78 | -------------------------------------------------------------------------------- /src/Checks/ComponentValidators/ComponentValidator.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file ComponentValidator.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2016-05-30 6 | ' @brief Validates schematic components. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | ' @brief Module name for error and message reporting 14 | Private ModuleName 15 | ModuleName = "ComponentValidator.vbs" 16 | 17 | ' @brief Validates schematic components. 18 | ' @details This includes checking that the designator is o.k., and that the correct values are shown on the schematic 19 | ' (for selected component types). 20 | ' @param DummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 21 | ' @note Designator symbols are defined in Config.vbs. 22 | Sub ComponentValidator(DummyVar) 23 | Dim workspace ' As IWorkspace 24 | Dim pcbProject ' As IProject 25 | Dim document ' As IDocument 26 | Dim flatHierarchy ' As IDocument 27 | Dim sheet ' As ISch_Document 28 | Dim docNum ' As Integer 29 | Dim iterator ' As ISch_Iterator 30 | Dim compIterator ' As ISch_Iterator 31 | Dim component ' As IComponent 32 | Dim parameter ' As ISch_Parameter 33 | Dim violationCount ' As Integer 34 | 35 | StdOut("Validating components...") 36 | 37 | violationCount = 0 38 | 39 | ' Obtain the schematic server interface. 40 | If SchServer Is Nothing Then 41 | StdErr("ERROR: Schematic server not online." + VbLf + VbCr) 42 | Exit Sub 43 | End If 44 | 45 | ' Get pcb project interface 46 | Set workspace = GetWorkspace 47 | Set pcbProject = workspace.DM_FocusedProject 48 | 49 | If pcbProject Is Nothing Then 50 | StdErr("ERROR: Current Project is not a PCB Project" + VbLf + VbCr) 51 | Exit Sub 52 | End If 53 | 54 | ' Compile project 55 | Set flatHierarchy = PCBProject.DM_DocumentFlattened 56 | 57 | ' If we couldn't get the flattened sheet, then most likely the project has 58 | ' not been compiled recently 59 | If flatHierarchy Is Nothing Then 60 | StdErr("ERROR: Compile the project before running this script." + VbCr + VbLf) 61 | End If 62 | 63 | ' Loop through all project documents 64 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 65 | Set document = pcbProject.DM_LogicalDocuments(docNum) 66 | 67 | ' If this is SCH document 68 | If document.DM_DocumentKind = "SCH" Then 69 | Set sheet = SCHServer.GetSchDocumentByPath(document.DM_FullPath) 70 | 'ShowMessage(document.DM_FullPath); 71 | If sheet Is Nothing Then 72 | StdErr("ERROR: No sheet found." + VbCr + VbLf) 73 | Exit Sub 74 | End If 75 | 76 | ' Set up iterator to look for power port objects only 77 | Set iterator = sheet.SchIterator_Create 78 | If iterator Is Nothing Then 79 | StdErr("ERROR: Iterator could not be created.") 80 | Exit Sub 81 | End If 82 | 83 | ' Add filter for only schematic components 84 | iterator.AddFilter_ObjectSet(MkSet(eSchComponent)) 85 | Set component = Iterator.FirstSchObject 86 | 87 | ' ============================ 88 | ' ===== COMPONENT LOOP ======= 89 | ' ============================ 90 | Do While Not (component Is Nothing) 91 | 92 | ' First, make sure component is a capacitor 93 | Dim Regex 94 | Set Regex = New RegExp 95 | Regex.IgnoreCase = True 96 | Regex.Global = True 97 | ' Look for a designator 98 | ' Designators are one ore more capital letters followed by 99 | ' one or more numerals, with nothing else before or afterwards (i.e. anchored using ^ and $) 100 | Regex.Pattern = "^[A-Z][A-Z]*[0-9][0-9]*$" 101 | 102 | ' Check for pattern match, using execute method. 103 | Dim MatchColl 104 | Set MatchColl = Regex.Execute(component.Designator.Text) 105 | 106 | ' Make sure only one match was found 107 | If MatchColl.Count = 1 Then 108 | ' Extract letters from designator 109 | Regex.Pattern = "^[A-Z][A-Z]*" 110 | Set MatchColl = Regex.Execute(MatchColl.Item(0).Value) 111 | 112 | ' Make sure the designator letter(s) is valid 113 | ' Certain components have more than just a designator validator, we 114 | ' also make sure they are displaying the correct values. These 115 | ' are separate functions which are called from this SELECT 116 | 117 | ' Designator symbols are defined in Config.vbs 118 | Select Case MatchColl.Item(0).Value 119 | 120 | Case DESIGNATOR_ANTENNA 121 | Case DESIGNATOR_CABLE 122 | Case DESIGNATOR_CAPACITOR 123 | If ValidateCapacitor(component) = False Then 124 | violationCount = violationCount + 1 125 | End If 126 | 127 | Case DESIGNATOR_CONNECTOR_JACK 128 | Case DESIGNATOR_CONNECTOR_PLUG 129 | Case DESIGNATOR_CRYSTAL 130 | Case DESIGNATOR_DIODE 131 | Case DESIGNATOR_FUSE 132 | Case DESIGNATOR_FERRITE_BEAD 133 | Case DESIGNATOR_FIDUCIAL 134 | Case DESIGNATOR_FUSE_HOLDER 135 | Case DESIGNATOR_IC 136 | If ValidateIC(component) = False Then 137 | violationCount = violationCount + 1 138 | End If 139 | 140 | Case DESIGNATOR_INDUCTOR 141 | If ValidateInductor(component) = False Then 142 | violationCount = violationCount + 1 143 | End If 144 | 145 | Case DESIGNATOR_MECHANICAL_PART 146 | Case DESIGNATOR_MOTOR 147 | Case DESIGNATOR_RESISTOR 148 | If ValidateResistor(component) = False Then 149 | violationCount = violationCount + 1 150 | End If 151 | 152 | Case DESIGNATOR_SOLAR_PANEL 153 | Case DESIGNATOR_SPARK_GAP 154 | Case DESIGNATOR_SWITCH 155 | Case DESIGNATOR_TEST_POINT 156 | Case DESIGNATOR_TRANSISTOR 157 | Case DESIGNATOR_TRANSFORMER 158 | Case DESIGNATOR_VARIABLE_RESISTOR 159 | Case DESIGNATOR_VARISTOR 160 | 161 | Case Else 162 | Call StdErr(ModuleName, "'" + MatchColl.Item(0).Value + "' is not a recognised designator (" + component.Designator.Text + ").") 163 | End Select 164 | Else 165 | Call StdErr(ModuleName, "Designator '" + component.Designator.Text + "' does not follow the valid designator syntax.") 166 | End If 167 | 168 | ' Go to next schematic component 169 | Set component = iterator.NextSchObject 170 | Loop ' Do While Not (component Is Nothing) 171 | 172 | sheet.SchIterator_Destroy(iterator) 173 | 174 | End If ' If document.DM_DocumentKind = "SCH" Then 175 | 176 | Next ' For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 177 | 178 | If violationCount = 0 Then 179 | StdOut("No component violations found. ") 180 | Else 181 | StdOut("ERROR: Component violation(s) found. Number of violations = '" + IntToStr(violationCount) + "'. ") 182 | End If 183 | 184 | StdOut("Component validating finished." + VbCr + VbLf) 185 | End Sub 186 | -------------------------------------------------------------------------------- /src/Checks/ComponentValidators/ValidateCapacitor.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file ValidateCapacitor.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2015-01-08 6 | ' @brief Validates a capacitor component that is on a schematic. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private ModuleName 14 | ModuleName = "ValidateCapacitor.vbs" 15 | 16 | Function ValidateCapacitor(component) 17 | Dim CapacitanceFound ' As Boolean 18 | Dim VoltageFound ' As Boolean 19 | 20 | ' Create component iterator, masking only parameters 21 | Dim CompIterator 22 | CompIterator = Component.SchIterator_Create 23 | CompIterator.AddFilter_ObjectSet(MkSet(eParameter)) 24 | 25 | Dim Parameter 26 | Set Parameter = CompIterator.FirstSchObject 27 | 28 | ' Reset flags 29 | CapacitanceFound = false 30 | VoltageFound = false 31 | 32 | ' Loop through all parameters in object 33 | Do While Not (Parameter Is Nothing) 34 | ' Check for supplier part number parameter thats visible on sheet 35 | 36 | ' Project and version regex 37 | Dim Regex 38 | Set Regex = New RegExp 39 | Regex.IgnoreCase = False 40 | Regex.Global = True 41 | ' Look for date in pattern yyyy/mm/dd 42 | Regex.Pattern = "^[0-9]*\.?[0-9]*V$" 43 | 44 | If Regex.Test(Parameter.Text) And Parameter.IsHidden = false Then 45 | VoltageFound = true 46 | End If 47 | 48 | ' Look for capacitance 49 | Regex.Pattern = "^[0-9]*\.?[0-9]*[pnum]?F$" 50 | 51 | If Regex.Test(Parameter.Text) And Parameter.IsHidden = false Then 52 | CapacitanceFound = true 53 | End If 54 | 55 | 'if ((AnsiUpperCase(Parameter.Name) = 'GROUP') and (Parameter.Text <> '') and (Parameter.Text <> '*')) then 56 | ' if StrToInt(Parameter.Text) > MaxNumber then 57 | ' MaxNumber := StrToInt(Parameter.Text); 58 | 59 | Set Parameter = CompIterator.NextSchObject 60 | Loop ' Do While Not (parameter Is Nothing) 61 | 62 | Component.SchIterator_Destroy(CompIterator) 63 | 64 | If(CapacitanceFound = false) Then 65 | Call StdErr(ModuleName, "'" + Component.Designator.Text + "' does not show it's capacitance.") 66 | End If 67 | 68 | If(VoltageFound = false) Then 69 | Call StdErr(ModuleName, "'" + Component.Designator.Text + "' does not show it's voltage.") 70 | End If 71 | 72 | If(CapacitanceFound = false) Or (VoltageFound = false) Then 73 | ValidateCapacitor = false 74 | Else 75 | ValidateCapacitor = true 76 | End If 77 | End Function 78 | -------------------------------------------------------------------------------- /src/Checks/ComponentValidators/ValidateIC.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file ValidateIC.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2015-04-14 5 | ' @last-modified 2015-08-04 6 | ' @brief Validates a IC component that is on a schematic. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private ModuleName 14 | ModuleName = "ValidateIC.vbs" 15 | 16 | ' @brief Validates a resistor component. 17 | Function ValidateIC(component) 18 | Dim manfPartNumFound ' As Boolean 19 | 20 | ' Create component iterator, masking only parameters 21 | Dim compIterator 22 | compIterator = component.SchIterator_Create 23 | compIterator.AddFilter_ObjectSet(MkSet(eParameter)) 24 | 25 | Dim parameter 26 | Set parameter = compIterator.FirstSchObject 27 | 28 | ' Reset flags 29 | manfPartNumFound = false 30 | 31 | ' Loop through all parameters in object 32 | Do While Not (parameter Is Nothing) 33 | ' Check for supplier part number parameter thats visible on sheet 34 | 35 | ' Lets use regex to find the manufacturer part number 36 | Dim regex 37 | Set regex = New RegExp 38 | regex.IgnoreCase = False 39 | regex.Global = True 40 | ' Look for parameter name (NOT it's value, this could be anything!) 41 | ' Lets not anchor the end either, some components have a " 1", " 2", e.t.c addition 42 | ' to the end 43 | regex.Pattern = "^Manufacturer Part Number" 44 | 45 | If regex.Test(parameter.Name) And parameter.IsHidden = false Then 46 | 'StdOut("Resistance found!") 47 | manfPartNumFound = true 48 | End If 49 | 50 | Set parameter = compIterator.NextSchObject 51 | Loop ' Do While Not (parameter Is Nothing) 52 | 53 | component.SchIterator_Destroy(compIterator) 54 | 55 | If(manfPartNumFound = false) Then 56 | Call StdErr(ModuleName, "'" + component.Designator.Text + "' does not show it's manf. part number (looking for the parameter 'Manufacturer Part Number' with optional numbers at the end.") 57 | End If 58 | 59 | If manfPartNumFound = false Then 60 | ValidateIC = false 61 | Else 62 | ValidateIC = true 63 | End If 64 | End Function 65 | -------------------------------------------------------------------------------- /src/Checks/ComponentValidators/ValidateInductor.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file ValidateInductor.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2015-01-08 6 | ' @brief Validates a inductor component that is on a schematic. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private ModuleName 14 | ModuleName = "ValidateInductor.vbs" 15 | 16 | Function ValidateInductor(Component) 17 | Dim InductanceFound ' As Boolean 18 | Dim CurrentFound ' As Boolean 19 | 20 | ' Create component iterator, masking only parameters 21 | Dim CompIterator 22 | CompIterator = Component.SchIterator_Create 23 | CompIterator.AddFilter_ObjectSet(MkSet(eParameter)) 24 | 25 | Dim Parameter 26 | Set Parameter = CompIterator.FirstSchObject 27 | 28 | ' Reset flags 29 | InductanceFound = false 30 | CurrentFound = false 31 | 32 | ' Loop through all parameters in object 33 | Do While Not (Parameter Is Nothing) 34 | 35 | ' Project and version regex 36 | Dim Regex 37 | Set Regex = New RegExp 38 | Regex.IgnoreCase = False 39 | Regex.Global = True 40 | 41 | ' Look for inductance 42 | Regex.Pattern = "^[0-9][0-9]*(\.[0-9][0-9]*)?[um]?H$" 43 | 44 | If Regex.Test(Parameter.Text) And Parameter.IsHidden = false Then 45 | InductanceFound = true 46 | End If 47 | 48 | ' Look for current 49 | Regex.Pattern = "^[0-9][0-9]*(\.[0-9][0-9]*)?[m]?A$" 50 | 51 | If Regex.Test(Parameter.Text) And Parameter.IsHidden = false Then 52 | CurrentFound = true 53 | End If 54 | 55 | Set Parameter = CompIterator.NextSchObject 56 | Loop ' Do While Not (parameter Is Nothing) 57 | 58 | Component.SchIterator_Destroy(CompIterator) 59 | 60 | If(InductanceFound = False) Then 61 | Call StdErr(ModuleName, "'" + component.Designator.Text + "' does not show it's inductance.") 62 | End If 63 | 64 | If(CurrentFound = False) Then 65 | Call StdErr(ModuleName, "'" + component.Designator.Text + "' does not show it's current.") 66 | End If 67 | 68 | ' Return 69 | If(inductanceFound = False) Or (currentFound = False) Then 70 | ValidateInductor = False 71 | Else 72 | ValidateInductor = True 73 | End If 74 | End Function 75 | -------------------------------------------------------------------------------- /src/Checks/ComponentValidators/ValidateResistor.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file ValidateResistor.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2016-04-27 6 | ' @brief Validates a resistor component that is on a schematic. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private ModuleName 14 | ModuleName = "ValidateResistor.vbs" 15 | 16 | ' @brief Validates a resistor component. 17 | Function ValidateResistor(component) 18 | Dim resistanceFound ' As Boolean 19 | 20 | ' Create component iterator, masking only parameters 21 | Dim compIterator 22 | compIterator = component.SchIterator_Create 23 | compIterator.AddFilter_ObjectSet(MkSet(eParameter)) 24 | 25 | Dim parameter 26 | Set parameter = compIterator.FirstSchObject 27 | 28 | ' Reset flags 29 | resistanceFound = false 30 | 31 | ' Loop through all parameters in object 32 | Do While Not (parameter Is Nothing) 33 | ' Check for supplier part number parameter thats visible on sheet 34 | 35 | ' Lets use regex to find the resistance 36 | Dim regex 37 | Set regex = New RegExp 38 | regex.IgnoreCase = False 39 | regex.Global = True 40 | ' Look for resistance 41 | ' This allows for resistances with the letters m, R, k or M at the end, 42 | ' OR one of those prefixes AND an Ohm symbol. 0389 is the hex number for capital Ohm symbol (use Windows charmap.exe to find this) 43 | regex.Pattern = "^[0-9][0-9]*(\.[0-9][0-9]*)?([mRkM]|([mRkM]?" + ChrW(&H03A9) + "))$$" 44 | 45 | If regex.Test(parameter.Text) And parameter.IsHidden = false Then 46 | 'StdOut("Resistance found!") 47 | resistanceFound = true 48 | End If 49 | 50 | Set parameter = compIterator.NextSchObject 51 | Loop ' Do While Not (parameter Is Nothing) 52 | 53 | component.SchIterator_Destroy(compIterator) 54 | 55 | If(resistanceFound = false) Then 56 | Call StdErr(ModuleName, "'" + component.Designator.Text + "' does not show it's resistance.") 57 | End If 58 | 59 | If resistanceFound = false Then 60 | ValidateResistor = false 61 | Else 62 | ValidateResistor = true 63 | End If 64 | End Function 65 | -------------------------------------------------------------------------------- /src/Checks/PowerPortChecker.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file PowerPortChecker.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2015-01-24 6 | ' @brief Deletes all schematic parameters for the current project. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private ModuleName 14 | ModuleName = "PowerPortChecker.vbs" 15 | 16 | ' @param DummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 17 | Function PowerPortChecker(dummyVar) 18 | Dim Workspace ' As IWorkspace 19 | Dim PcbProject ' As IProject 20 | Dim powerObj ' As ISch_PowerObject 21 | Dim document ' As IDocument 22 | Dim sheet ' As ISch_Document 23 | Dim iterator ' As ISch_Iterator 24 | Dim docNum ' As Integer 25 | Dim violationCnt ' As Integer 26 | Dim regex 27 | 28 | violationCnt = 0 29 | 30 | StdOut("Checking power ports...") 31 | 32 | ' Obtain the schematic server interface. 33 | If SchServer Is Nothing Then 34 | Call StdErr(ModuleName, "ERROR: Schematic server is not online.") 35 | Exit Function 36 | End If 37 | 38 | ' Get pcb project interface 39 | Set Workspace = GetWorkspace 40 | Set PcbProject = Workspace.DM_FocusedProject 41 | 42 | ' Initialize the robots in Schematic editor. 43 | ' SchServer.ProcessControl.PreProcess(CurrentSheet, ''); 44 | 45 | Dim SchDocument 46 | 47 | ' Loop through all project documents 48 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 49 | 50 | Set document = pcbProject.DM_LogicalDocuments(docNum) 51 | 52 | ' If this is SCH document 53 | If document.DM_DocumentKind = "SCH" Then 54 | 55 | ' Open document first as GetSchDocumentByPath only gets document if it is open!!! 56 | SchDocument = Client.OpenDocument("SCH", document.DM_FullPath) 57 | Set sheet = SCHServer.GetSchDocumentByPath(document.DM_FullPath) 58 | If sheet Is Nothing Then 59 | Call StdErr(ModuleName, "Could not retrieve '" + document.DM_FullPath + "'. Please compile project.") 60 | Exit Function 61 | End If 62 | 63 | ' Set up iterator to look for popwer port objects only 64 | Set iterator = sheet.SchIterator_Create 65 | If iterator Is Nothing Then 66 | Call StdErr(ModuleName, "Iterator creation failed.") 67 | Exit Function 68 | End If 69 | 70 | iterator.AddFilter_ObjectSet(MkSet(ePowerObject)) 71 | 72 | Set powerObj = iterator.FirstSchObject 73 | 74 | Do While Not (powerObj Is Nothing) 75 | 76 | If(powerObj.Style = ePowerGndPower) Or (powerObj.Style = ePowerGndSignal) Or (powerObj.Style = ePowerGndEarth) Then 77 | 78 | ' Make sure they are facing downwards 79 | If Not(powerObj.Orientation = eRotate270) Then 80 | violationCnt = violationCnt + 1 81 | Call StdErr(moduleName, "Gound symbol '" + powerObj.Text + "' with incorrect orientation on sheet " + document.DM_FullPath + " found. ") 82 | End If 83 | End If 84 | If (powerObj.Style = ePowerBar) Then 85 | 86 | ' Make sure they are facing upwards 87 | If Not(powerObj.Orientation = eRotate90) Then 88 | violationCnt = violationCnt + 1 89 | Call StdErr(ModuleName, "Power bar '" + powerObj.Text + "' with incorrect orientation on sheet " + document.DM_FullPath + " found.") 90 | End If 91 | 92 | ' Check text 93 | Set regex = New RegExp 94 | regex.IgnoreCase = True 95 | regex.Global = True 96 | ' Look for a designator 97 | ' Designators are one ore more capital letters followed by 98 | ' one or more numerals, with nothing else before or afterwards (i.e. anchored) 99 | regex.Pattern = "[\+-][0-9]+\.[0-9]+V" 100 | 101 | ' Check for pattern match 102 | If Not regex.Test(powerObj.Text) Then 103 | 'violationCnt = violationCnt + 1 104 | 'Call StdErr("ERROR: Power bar with incorrect text " + powerObj.Text + " on sheet " + document.DM_FullPath + " found. ") 105 | End If 106 | End If 107 | 108 | ' Go to next object 109 | If iterator.NextSchObject Is Nothing Then 110 | Exit Do 111 | End If 112 | Set powerObj = iterator.NextSchObject 113 | Loop 114 | End If 115 | Next 116 | 117 | If(violationCnt = 0) Then 118 | StdOut("No power port violations found. ") 119 | Else 120 | StdOut("ERROR: Power ports violations found! Number of violations = " + IntToStr(violationCnt) + ". ") 121 | End If 122 | 123 | StdOut("Power port checking finished." + VbCr + VbLf) 124 | End Function 125 | 126 | -------------------------------------------------------------------------------- /src/Checks/PreReleaseChecks.dfm: -------------------------------------------------------------------------------- 1 | object FormPreReleaseChecks: TFormPreReleaseChecks 2 | Left = 0 3 | Top = 0 4 | Caption = 'Pre-release Checks' 5 | ClientHeight = 654 6 | ClientWidth = 844 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object lblErrors: TLabel 17 | Left = 42 18 | Top = 324 19 | Width = 98 20 | Height = 39 21 | Caption = 'Errors' 22 | Font.Charset = DEFAULT_CHARSET 23 | Font.Color = clWindowText 24 | Font.Height = -32 25 | Font.Name = 'Tahoma' 26 | Font.Style = [fsBold] 27 | ParentFont = False 28 | end 29 | object Label1: TLabel 30 | Left = 42 31 | Top = 12 32 | Width = 101 33 | Height = 39 34 | Caption = 'Status' 35 | Font.Charset = DEFAULT_CHARSET 36 | Font.Color = clWindowText 37 | Font.Height = -32 38 | Font.Name = 'Tahoma' 39 | Font.Style = [fsBold] 40 | ParentFont = False 41 | end 42 | object MemoStdOut: TMemo 43 | Left = 33 44 | Top = 61 45 | Width = 655 46 | Height = 259 47 | ScrollBars = ssVertical 48 | TabOrder = 0 49 | end 50 | object MemoStdErr: TMemo 51 | Left = 33 52 | Top = 373 53 | Width = 655 54 | Height = 259 55 | Font.Charset = DEFAULT_CHARSET 56 | Font.Color = clRed 57 | Font.Height = -11 58 | Font.Name = 'Tahoma' 59 | Font.Style = [] 60 | ParentFont = False 61 | ScrollBars = ssVertical 62 | TabOrder = 1 63 | end 64 | end 65 | -------------------------------------------------------------------------------- /src/Checks/PreReleaseChecks.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file RunPreReleaseChecks.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2014-11-25 5 | ' @last-modified 2015-08-06 6 | ' @brief Main entry point for the pre-release checks. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' @brief Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | ' @brief Name of this module. Used for debugging/warning/error message purposes and for 14 | ' saving user data. 15 | Private Const moduleName = "RunPreReleaseChecks.vbs" 16 | 17 | Private dummyVar 18 | 19 | Function StdOut(msg) 20 | ' Output text 21 | MemoStdOut.Text = MemoStdOut.Text + msg 22 | End Function 23 | 24 | Sub StdOutNl(msg) 25 | ' Output text 26 | MemoStdOut.Text = MemoStdOut.Text + msg + VbCr + VbLf 27 | End Sub 28 | 29 | Function StdErr(moduleName, msg) 30 | ' Output text 31 | MemoStdErr.Text = MemoStdErr.Text + "ERROR (" + moduleName + "): " + msg + VbCr + VbLf 32 | End Function 33 | 34 | 35 | ' @brief Main entry point for pre-release checks. 36 | ' @details Call from main form to run and show pre-release checks. 37 | Sub PreReleaseChecksMain(dummyVar) 38 | 39 | ' PROJECT 40 | ' Important to check if project compiles first 41 | If CheckProjectCompiles(dummyVar) = False Then 42 | ShowMessage("ERROR: Could not compile project.") 43 | Exit Sub 44 | End If 45 | 46 | ' ============== SCHEMATICS ================= 47 | PowerPortChecker(dummyVar) 48 | CheckNoSupplierPartNumShown(dummyVar) 49 | ComponentValidator(dummyVar) 50 | CheckEmbeddedImages(dummyVar) 51 | 52 | ' ================== PCB =================== 53 | 54 | ' First we want to make sure we have access to a PCB document 55 | If CheckWeHavePcbDocAccess(dummyVar) = True Then 56 | ' Since we have access, we can now run all PCB checks 57 | CheckLayers(dummyVar) 58 | CheckTentedVias(dummyVar) 59 | CheckNameVersionDate(dummyVar) 60 | CheckPcbTextHasCorrectOrientation(dummyVar) 61 | CheckPcbCompDesignatorRotation(dummyVar) 62 | CheckPcbCompPrimitivesLocked(dummyVar) 63 | ' 2014-11-11: CheckComponentLinks() doesn't actually check the links automatically, it 64 | ' just opens up the component link window for the user, so I've commented this 65 | ' script out 66 | 'CheckComponentLinks(DummyVar) 67 | End If 68 | 69 | 70 | FormPreReleaseChecks.ShowModal 71 | 72 | End Sub 73 | -------------------------------------------------------------------------------- /src/Config.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file Config.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2016-05-30 6 | ' @brief Configuration settings and variables for AltiumScriptCentral. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private ModuleName 14 | ModuleName = "Config.vbs" 15 | 16 | ' @brief The default file name (minus extension) for the user data. 17 | ' @details Changing this will cause any existing user data to be lost (unless 18 | ' you renamed the file also). 19 | Const DEFAULT_FILE_NAME_FOR_USER_DATA = "AltiumScriptCentral_UserData" 20 | 21 | Dim BOARD_OUTLINE_LAYER 22 | Dim PCB_INFO_LAYER 23 | Dim TOP_DIMENSIONS_LAYER 24 | Dim BOT_DIMENSIONS_LAYER 25 | Dim TOP_MECH_BODY_LAYER 26 | Dim BOT_MECH_BODY_LAYER 27 | Dim TOP_COURTYARD_LAYER 28 | Dim BOT_COURTYARD_LAYER 29 | Dim UNUSED_LAYERS 30 | 31 | Const MIN_TENTED_VIA_RATIO = 0.90 32 | 33 | '===================== COMPONENT DESIGNATOR DEFINITIONS =======================' 34 | 35 | ' Sorted alphabetically by designator acronym 36 | 37 | Const DESIGNATOR_BATTERY = "BT" 38 | Const DESIGNATOR_CAPACITOR = "C" 39 | Const DESIGNATOR_DIODE = "D" 40 | Const DESIGNATOR_ANTENNA = "E" 41 | Const DESIGNATOR_FUSE = "F" 42 | Const DESIGNATOR_FERRITE_BEAD = "FB" 43 | Const DESIGNATOR_FIDUCIAL = "FD" 44 | Const DESIGNATOR_CONNECTOR_JACK = "J" 45 | Const DESIGNATOR_INDUCTOR = "L" 46 | Const DESIGNATOR_MOTOR = "M" 47 | Const DESIGNATOR_MECHANICAL_PART = "MP" 48 | Const DESIGNATOR_CONNECTOR_PLUG = "P" 49 | Const DESIGNATOR_SOLAR_PANEL = "PV" 50 | Const DESIGNATOR_TRANSISTOR = "Q" 51 | Const DESIGNATOR_RESISTOR = "R" 52 | Const DESIGNATOR_VARISTOR = "RV" 53 | Const DESIGNATOR_SPARK_GAP = "SG" 54 | Const DESIGNATOR_SWITCH = "SW" 55 | Const DESIGNATOR_TRANSFORMER = "T" 56 | Const DESIGNATOR_TEST_POINT = "TP" 57 | Const DESIGNATOR_IC = "U" 58 | Const DESIGNATOR_VARIABLE_RESISTOR = "VR" 59 | Const DESIGNATOR_CABLE = "W" 60 | Const DESIGNATOR_CRYSTAL = "XC" 61 | Const DESIGNATOR_FUSE_HOLDER = "XF" 62 | 63 | ' @brief The parameter name for the scheamtic number 64 | Const SCHEMATIC_SHEET_COUNT_PARAM_NAME = "SheetNumber" 65 | 66 | ' @brief The parameter name for the total number of schematic sheets 67 | Const TOTAL_SHEET_PARAM_NAME = "SheetTotal" 68 | 69 | ' @brief Initialisation function which sets up environment for the rest of 70 | ' AltiumScriptCentral to work correctly. 71 | ' @details All variables in here cannot be setup as constants. 72 | Sub ConfigInit(dummyVar) 73 | 74 | ' BOARD LAYERS 75 | BOARD_OUTLINE_LAYER = eMechanical1 76 | PCB_INFO_LAYER = eMechanical2 77 | TOP_DIMENSIONS_LAYER = eMechanical11 78 | BOT_DIMENSIONS_LAYER = eMechanical12 79 | TOP_MECH_BODY_LAYER = eMechanical13 80 | BOT_MECH_BODY_LAYER = eMechanical14 81 | TOP_COURTYARD_LAYER = eMechanical15 82 | BOT_COURTYARD_LAYER = eMechanical16 83 | UNUSED_LAYERS = MkSet(eMechanical3, eMechanical4, eMechanical5, eMechanical6, eMechanical7, eMechanical8, eMechanical9, eMechanical10) 84 | 85 | End Sub 86 | -------------------------------------------------------------------------------- /src/Main.dfm: -------------------------------------------------------------------------------- 1 | object FormMainScript: TFormMainScript 2 | Left = 0 3 | Top = 0 4 | Caption = 'Altium Script Central' 5 | ClientHeight = 457 6 | ClientWidth = 973 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormMain_Create 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Label2: TLabel 18 | Left = 730 19 | Top = 20 20 | Width = 159 21 | Height = 39 22 | Caption = 'PCB Tools' 23 | Font.Charset = DEFAULT_CHARSET 24 | Font.Color = clWindowText 25 | Font.Height = -32 26 | Font.Name = 'Tahoma' 27 | Font.Style = [fsBold] 28 | ParentFont = False 29 | end 30 | object Label1: TLabel 31 | Left = 362 32 | Top = 20 33 | Width = 261 34 | Height = 39 35 | Caption = 'Schematic Tools' 36 | Font.Charset = DEFAULT_CHARSET 37 | Font.Color = clWindowText 38 | Font.Height = -32 39 | Font.Name = 'Tahoma' 40 | Font.Style = [fsBold] 41 | ParentFont = False 42 | end 43 | object Label3: TLabel 44 | Left = 66 45 | Top = 20 46 | Width = 211 47 | Height = 39 48 | Caption = 'Project Tools' 49 | Font.Charset = DEFAULT_CHARSET 50 | Font.Color = clWindowText 51 | Font.Height = -32 52 | Font.Name = 'Tahoma' 53 | Font.Style = [fsBold] 54 | ParentFont = False 55 | end 56 | object Panel3: TPanel 57 | Left = 658 58 | Top = 64 59 | Width = 286 60 | Height = 320 61 | ParentBackground = False 62 | TabOrder = 14 63 | end 64 | object Panel2: TPanel 65 | Left = 346 66 | Top = 64 67 | Width = 286 68 | Height = 320 69 | ParentBackground = False 70 | TabOrder = 13 71 | object ButtonComponentParameterStamper: TButton 72 | Left = 41 73 | Top = 147 74 | Width = 205 75 | Height = 25 76 | Caption = 'Component Parameter Stamper' 77 | TabOrder = 0 78 | OnClick = ButtonComponentParameterStamperClick 79 | end 80 | object ButtonSwapSchematicDesignators: TButton 81 | Left = 41 82 | Top = 179 83 | Width = 205 84 | Height = 25 85 | Caption = 'Swap Designators' 86 | TabOrder = 1 87 | OnClick = ButtonSwapSchematicDesignatorsClick 88 | end 89 | end 90 | object Panel1: TPanel 91 | Left = 34 92 | Top = 64 93 | Width = 286 94 | Height = 320 95 | Ctl3D = True 96 | ParentBackground = False 97 | ParentCtl3D = False 98 | ShowCaption = False 99 | TabOrder = 12 100 | end 101 | object ButPushProjectParameters: TButton 102 | Left = 386 103 | Top = 176 104 | Width = 206 105 | Height = 24 106 | Caption = 'Push Project Parameters To Schematics' 107 | TabOrder = 0 108 | OnClick = ButtonPushProjectParametersToSchematics_Click 109 | end 110 | object ButRenumberPads: TButton 111 | Left = 706 112 | Top = 208 113 | Width = 206 114 | Height = 24 115 | Caption = 'Renumber Pads' 116 | TabOrder = 1 117 | OnClick = ButtonRenumberPads_Click 118 | end 119 | object Button2: TButton 120 | Left = 708 121 | Top = 238 122 | Width = 204 123 | Height = 25 124 | Caption = 'Resize Designators' 125 | TabOrder = 2 126 | OnClick = ButtonResizeDesignators_Click 127 | end 128 | object ButNumberSchematics: TButton 129 | Left = 388 130 | Top = 142 131 | Width = 204 132 | Height = 25 133 | Caption = 'Number Schematics' 134 | TabOrder = 3 135 | OnClick = ButNumberSchematics_Click 136 | end 137 | object ButRotateDesignators: TButton 138 | Left = 708 139 | Top = 270 140 | Width = 204 141 | Height = 25 142 | Caption = 'Rotate Designators' 143 | TabOrder = 4 144 | OnClick = ButtonRotateDesignators_Click 145 | end 146 | object ButDeleteSchParams: TButton 147 | Left = 388 148 | Top = 110 149 | Width = 204 150 | Height = 26 151 | Caption = 'Delete Schematic Parameters' 152 | TabOrder = 5 153 | OnClick = ButDeleteSchParams_Click 154 | end 155 | object ButAddSpecialSchematicParameters: TButton 156 | Left = 388 157 | Top = 78 158 | Width = 204 159 | Height = 25 160 | Caption = 'Add Special Schematic Parameters' 161 | TabOrder = 6 162 | OnClick = ButAddSpecialSchematicParameters_Click 163 | end 164 | object ButtonDisplayPcbStats: TButton 165 | Left = 708 166 | Top = 110 167 | Width = 204 168 | Height = 25 169 | Caption = 'Display PCB Stats' 170 | TabOrder = 7 171 | OnClick = ButtonDisplayPcbStats_Click 172 | end 173 | object ButtonViaStamper: TButton 174 | Left = 708 175 | Top = 302 176 | Width = 204 177 | Height = 26 178 | Caption = 'Via Stamper' 179 | TabOrder = 8 180 | OnClick = ButtonViaStamper_Click 181 | end 182 | object ButtonDrawPolygon: TButton 183 | Left = 708 184 | Top = 142 185 | Width = 204 186 | Height = 25 187 | Caption = 'Draw Polygon' 188 | TabOrder = 9 189 | OnClick = ButtonDrawPolygon_Click 190 | end 191 | object ButtonCurrentCalculator: TButton 192 | Left = 708 193 | Top = 78 194 | Width = 204 195 | Height = 26 196 | Caption = 'Current Calculator' 197 | TabOrder = 10 198 | OnClick = ButtonCurrentCalculator_Click 199 | end 200 | object ButtonRunPreReleaseChecks: TButton 201 | Left = 74 202 | Top = 112 203 | Width = 206 204 | Height = 24 205 | Caption = 'Run Pre-release Checks' 206 | TabOrder = 11 207 | OnClick = ButtonRunPreReleaseChecks_Click 208 | end 209 | object ButtonSwapComponents: TButton 210 | Left = 708 211 | Top = 174 212 | Width = 204 213 | Height = 26 214 | Caption = 'Swap Components' 215 | TabOrder = 15 216 | OnClick = ButtonSwapComponents_Click 217 | end 218 | object ButtonExitActiveCommand: TButton 219 | Left = 74 220 | Top = 80 221 | Width = 206 222 | Height = 24 223 | Caption = 'Exit Active Command' 224 | TabOrder = 16 225 | OnClick = ButtonExitActiveCommand_Click 226 | end 227 | object ButtonExit: TButton 228 | Left = 785 229 | Top = 408 230 | Width = 127 231 | Height = 25 232 | Caption = 'Exit' 233 | TabOrder = 17 234 | OnClick = ButtonExit_Click 235 | end 236 | end 237 | -------------------------------------------------------------------------------- /src/Main.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file Main.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2015-09-11 6 | ' @brief Main entry point for AltiumScriptCentral. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private ModuleName 14 | ModuleName = "Main.vbs" 15 | 16 | Private DummyVar 17 | 18 | ' @brief This sub should be visible in DXP->Run Script, and when clicked 19 | ' will run AltiumScript Central. 20 | Sub RunAltiumScriptCentral 21 | 22 | FormMainScript.ShowModal 23 | 'FormMainScript.Show 24 | 'ShowMessage("ShowModal returned!") 25 | End Sub 26 | 27 | ' Called when FormMain is created 28 | Sub FormMain_Create(Sender) 29 | ' Initialise global variables 30 | ConfigInit(DummyVar) 31 | End Sub 32 | 33 | 34 | Sub ButtonPushProjectParametersToSchematics_Click(Sender) 35 | FormMainScript.Hide 36 | FormMainScript.Close 37 | PushProjectParametersToSchematics(DummyVar) 38 | End Sub 39 | 40 | Sub ButtonRenumberPads_Click(Sender) 41 | 'FormMainScript.Visible = 0 42 | 43 | ' Close closes the form for good 44 | FormMainScript.Close 45 | 46 | ' Open renumber pads form 47 | RenumberPads(dummyVar) 48 | 49 | End Sub 50 | 51 | Sub ButtonResizeDesignators_Click(Sender) 52 | ' Call script 53 | ResizeDesignators(dummyVar) 54 | 55 | ' Close main form for good 56 | FormMainScript.Close 57 | End Sub 58 | 59 | Sub ButNumberSchematics_Click(Sender) 60 | ' Close the main form before running number schematics script so we don't lock up Altium 61 | ' if NumberSchematics() throws an exception 62 | FormMainScript.Hide 63 | FormMainScript.Close 64 | NumberSchematics(dummyVar) 65 | End Sub 66 | 67 | ' Called when the "Rotate Designators" button is clicked 68 | Sub ButtonRotateDesignators_Click(Sender) 69 | FormMainScript.Hide 70 | RotateDesignators(dummyVar) 71 | FormMainScript.Close 72 | End Sub 73 | 74 | ' @brief Called when the "Delete Schematic Parameters" button is clicked 75 | Sub ButDeleteSchParams_Click(Sender) 76 | 'FormMainScript.Hide 77 | 'FormMainScript.Close 78 | 'DeleteAllSchematicParameters(DummyVar) 79 | 80 | FormMainScript.Height = 1 81 | FormMainScript.Width = 1 82 | 83 | DeleteSchematicParameters(DummyVar) 84 | 85 | FormMainScript.Close 86 | End Sub 87 | 88 | ' Called when the "Add Special Schematic Parameters" button is clicked 89 | Sub ButAddSpecialSchematicParameters_Click(Sender) 90 | AddSpecialSchParams(dummyVar) 91 | End Sub 92 | 93 | ' Called when the "Display PCB Stats" button is clicked 94 | Sub ButtonDisplayPcbStats_Click(Sender) 95 | 96 | 'FormMainScript.Hide 97 | 'Dim oShell 98 | 'Set oShell = CreateObject("WScript.Shell") 99 | 'oShell.SendKeys "(% )N" 100 | 'FormMainScript.Test = 2 101 | 'FormMainScript.Close 102 | 'oShell.sleep 500 103 | 104 | FormMainScript.Height = 50 105 | FormMainScript.Width = 50 106 | 107 | ' Show PCB stats form 108 | Call GetStats(DummyVar) 109 | FormStats.ShowModal 110 | 111 | FormMainScript.Close 112 | 113 | End Sub 114 | 115 | Sub ButtonDrawPolygon_Click(Sender) 116 | ' Close main form 117 | FormMainScript.Close 118 | 119 | ' Call DrawPolygon script 120 | DrawPolygon(DummyVar) 121 | End Sub 122 | 123 | Sub ButtonCurrentCalculator_Click(Sender) 124 | 125 | ' Hide main form 126 | 'FormMainScript.Hide 127 | 'FormMainScript.Visible = False 128 | 129 | ' Make the form small enough that it is not intrusive while the user selects a 130 | ' track to calculate current on. Note that this is the only way I could get it to work 131 | ' so that events on the child form fired (e.g. ButtonClick(Sender)) 132 | FormMainScript.Height = 100 133 | FormMainScript.Width = 100 134 | 135 | Call CurrentCalculator(dummyVar) 136 | 137 | FormMainScript.Close 138 | End Sub 139 | 140 | Sub ButtonRunPreReleaseChecks_Click(Sender) 141 | 142 | 'CheckTentedVias(dummyVar) 143 | 144 | ' Hide main form 145 | 'FormMainScript.Hide 146 | 147 | ' Show form, do not return until form is closed 148 | Call PreReleaseChecksMain(dummyVar) 149 | 150 | ' Close main form 151 | FormMainScript.Close 152 | End Sub 153 | 154 | Sub ButtonSwapComponents_Click(Sender) 155 | 156 | ' Hide main form 157 | FormMainScript.Hide 158 | 159 | Call SwapComponents(dummyVar) 160 | 161 | ' Close main form 162 | FormMainScript.Close 163 | 164 | End Sub 165 | 166 | Sub ButtonExitActiveCommand_Click(Sender) 167 | 168 | Call ExitActiveCommand(dummyVar) 169 | 170 | ' Close main form 171 | FormMainScript.Close 172 | End Sub 173 | 174 | Sub ButtonViaStamper_Click(Sender) 175 | ' Close main form for good 176 | 'FormMainScript.Hide 177 | 178 | FormMainScript.Height = 1 179 | FormMainScript.Width = 1 180 | 181 | ' Call via stamper script 182 | ViaStamper(dummyVar) 183 | 184 | FormMainScript.Close 185 | End Sub 186 | 187 | Sub ButtonExit_Click(Sender) 188 | 189 | ' Just close the main form 190 | FormMainScript.Close 191 | End Sub 192 | 193 | Sub ButtonComponentParameterStamperClick(Sender) 194 | FormMainScript.Hide 195 | FormMainScript.Close 196 | 197 | ' Call via stamper script 198 | SchCompParamStamper(dummyVar) 199 | 200 | 201 | End Sub 202 | 203 | Sub ButtonSwapSchematicDesignatorsClick(Sender) 204 | FormMainScript.Hide 205 | FormMainScript.Close 206 | 207 | Call SwapSchematicDesignators(dummyVar) 208 | End Sub 209 | -------------------------------------------------------------------------------- /src/Schematic/SchCompParamStamper.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file SchCompParamStamper.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2015-05-14 5 | ' @last-modified 2015-05-18 6 | ' @brief Script allows user to quickly 'stamp' the parameter visibility and location 7 | ' (relative to each component) settings of one schematic component to another. 8 | ' @details 9 | ' See README.rst in repo root dir for more info. 10 | 11 | ' Forces us to explicitly define all variables before using them 12 | Option Explicit 13 | 14 | ' @brief Test subroutine that can be called from the Altium script menu. 15 | ' @details Comment this subroutine out when releasing project. 16 | 'Sub SchCompParamStamperTest() 17 | ' dim dummyVar 18 | ' SchCompParamStamper(dummyVar) 19 | 'End Sub 20 | 21 | ' @brief Stamps (copies) vias to user-selected locations. 22 | ' @details Call this from AltiumScriptCentral. 23 | Sub SchCompParamStamper(dummyVar) 24 | 25 | ' Obtain the schematic server interface. 26 | If SchServer Is Nothing Then 27 | ShowMessage("ERROR: Schematic server not online." + VbLf + VbCr) 28 | Exit Sub 29 | End If 30 | 31 | ' Get current (active) schematic 32 | Dim currentSch 33 | currentSch = SchServer.GetCurrentSchDocument 34 | If currentSch Is Nothing Then 35 | ShowMessage("ERROR: The current active document (if any) is not a schematic." + VbLf + VbCr) 36 | Exit Sub 37 | End If 38 | 39 | 'ResetParameters 40 | 'Call AddStringParameter("Action", "AllOpenDocuments") 41 | 'RunProcess("Sch:DeSelect") 42 | 43 | '============ SOURCE COMPONENT ============' 44 | 45 | Dim sourceSchComp 46 | Set sourceSchComp = GetSchComponentFromUser(currentSch, "Choose source component.") 47 | 48 | If sourceSchComp Is Nothing Then 49 | Exit Sub 50 | End If 51 | 52 | If Not sourceSchComp.ObjectId = eSchComponent Then 53 | ShowMessage("ERROR: Selected object is not a schematic component!") 54 | Exit Sub 55 | End If 56 | 57 | 'ShowMessage("component.Location.X = '" + CStr(sourceSchComp.Location.X) + "'.") 58 | 59 | '============ DESTINATION COMPONENT ============' 60 | 61 | ' Lets loop this indefinitely, we will exit if the user presses the ESC key 62 | While True 63 | Dim destSchComp 64 | 65 | ' Note that if ESC is pressed now, Altium will display an error message all by itself, 66 | ' there is no way of disabling this 67 | Set destSchComp = GetSchComponentFromUser(currentSch, "Choose destination component.") 68 | 69 | If destSchComp Is Nothing Then 70 | Exit Sub 71 | End If 72 | 73 | If Not destSchComp.ObjectId = eSchComponent Then 74 | ShowMessage("ERROR: Selected object is not a schematic component!") 75 | Exit Sub 76 | End If 77 | 78 | '============ COPY ACROSS PARAMETER VISIBILITY AND LOCATION ============' 79 | 80 | Call CopyParameterVisibilityAndLocation(sourceSchComp, destSchComp) 81 | Wend 82 | 83 | End Sub 84 | 85 | Function GetSchComponentFromUser(schDoc, locationMsg) 86 | 87 | Set GetSchComponentFromUser = Nothing 88 | 89 | ' Request user to select origin component location 90 | Dim location' As TLocation 91 | location = TLocation 92 | 93 | If schDoc.ChooseLocationInteractively(location, locationMsg) = False Then 94 | ShowMessage("ERROR: A valid location was not choosen.") 95 | Exit Function 96 | End If 97 | 98 | 'ShowMessage("location.X = '" + CStr(location.X) + "', location.Y = '" + CStr(location.Y) + "'.") 99 | 100 | Dim schSourcePrim 101 | Set schSourcePrim = Nothing 102 | 103 | Do While schSourcePrim Is Nothing 104 | 105 | Dim spatialIterator 106 | spatialIterator = schDoc.SchIterator_Create 107 | If spatialIterator Is Nothing Then 108 | ShowMessage("ERROR: Failed to create spatial iterator.") 109 | Exit Function 110 | End If 111 | 112 | Call SpatialIterator.AddFilter_Area(Location.X - 1, Location.Y - 1, Location.X + 1, Location.Y + 1) 113 | 114 | ' Get first object 115 | Dim schTempPrim 116 | Set schTempPrim = spatialIterator.FirstSchObject 117 | 'schSourcePrim = schTempPrim 118 | 119 | ' Make sure iterator found an object 120 | If schTempPrim Is Nothing Then 121 | ShowMessage("ERROR: No schematic object was selected.") 122 | schDoc.SchIterator_Destroy(spatialIterator) 123 | Exit Function 124 | End If 125 | 126 | ' We found a schematic object 127 | Do While Not schTempPrim Is Nothing 128 | If (schTempPrim.ObjectId = eSchComponent) Then 129 | schSourcePrim = schTempPrim 130 | End If 131 | Set schTempPrim = spatialIterator.NextSchObject 132 | Loop 133 | 134 | ' We will get to here if either: 135 | ' - schematic component object found while iterating through objects at selected location, 136 | ' in this case we will exit from parent loop also 137 | ' - searched through all objects at this location and no schematic component 138 | ' found, in this case we will stay in parent loop 139 | 140 | schDoc.SchIterator_Destroy(spatialIterator) 141 | Loop 142 | 143 | ' Return schematic component (if any) 144 | GetSchComponentFromUser = schSourcePrim 145 | 146 | End Function 147 | 148 | ' @brief Copies across the parameter visibilities and locations (relative to each component) from the source component to the destination component. 149 | ' @details If the parameter in the source component is not found in the destination component, nothing happens. 150 | ' @param sourceSchComp The shcematic component to copy parameter visibility and location settings from. 151 | ' @param destSchComp The shcematic component to copy parameter visibility and location settings to. 152 | Function CopyParameterVisibilityAndLocation(sourceSchComp, destSchComp) 153 | 154 | Dim paramIterator 155 | ' Create an iterator from the source component 156 | paramIterator = sourceSchComp.SchIterator_Create 157 | ' Make sure the iterator mask will select on parameters 158 | paramIterator.AddFilter_ObjectSet(MkSet(eParameter)) 159 | 160 | Dim param 161 | param = paramIterator.FirstSchObject 162 | ' Iterate through all of the source component parameters 163 | Do Until param Is Nothing 164 | 'ShowMessage("param.Name = '" + param.Name + "'.") 165 | 'ShowMessage("param.Location.X = '" + CStr(param.Location.X) + "'.") 166 | Call SetSchCompParamVisibility(destSchComp, param.Name, param.IsHidden) 167 | 168 | ' ===== SET PARAMETER LOCATION ===== 169 | 170 | ' Get source parameter location relative to source component 171 | Dim relXLocation, relYLocation 172 | 173 | relXLocation = param.Location.X - sourceSchComp.Location.X 174 | relYLocation = param.Location.Y - sourceSchComp.Location.Y 175 | 'ShowMessage("relXLocation = '" + CStr(relXLocation) + "'.") 176 | 'ShowMessage("relYLocation = '" + CStr(relYLocation) + "'.") 177 | 178 | ' Set destination component parameters to the same relative location 179 | Call SetSchCompParamLocation(destSchComp, param.Name, destSchComp.Location.X + relXLocation, destSchComp.Location.Y + relYLocation) 180 | 181 | ' Next 182 | Set param = paramIterator.NextSchObject 183 | Loop 184 | 185 | sourceSchComp.SchIterator_Destroy(paramIterator) 186 | End Function 187 | 188 | ' @brief Changes the isHidden property (which hides or makes visible) of the specified component parameter. 189 | ' @details If the parameter is not found in the component, nothing happens. 190 | ' @param schComp The schematic component to operate on. 191 | ' @param paramName The parameter name to change the isHidden property of. 192 | ' @param isHidden (boolean) The value to set the isHidden property to. True 193 | ' will hide the property, false will make it visible. 194 | Function SetSchCompParamVisibility(schComp, paramName, isHidden) 195 | Dim paramIterator 196 | paramIterator = schComp.SchIterator_Create 197 | paramIterator.AddFilter_ObjectSet(MkSet(eParameter)) 198 | 199 | Dim param 200 | param = paramIterator.FirstSchObject 201 | Do Until param Is Nothing 202 | If param.Name = paramName Then 203 | ' We have found the correct parameter 204 | 'ShowMessage("Found match!") 205 | ' Set the parameter visibility to whatever was provided to this funciton 206 | param.IsHidden = isHidden 207 | 208 | ' Notify the schematic server of the change (so we can save) 209 | Call SchServer.RobotManager.SendMessage(param.I_ObjectAddress, c_BroadCast, SCHM_EndModify, c_NoEventData) 210 | End If 211 | Set param = paramIterator.NextSchObject 212 | Loop 213 | 214 | schComp.SchIterator_Destroy(paramIterator) 215 | 216 | End Function 217 | 218 | ' @brief Changes a parameter location for a specified schematic component. 219 | ' @details If the parameter is not found in the component, nothing happens. 220 | ' @param schComp The schematic component that the parameter belongs to. 221 | ' @param paramName (String) The name of the parameter. 222 | ' @param xLocation (Integer) The x-location of the to set the parameter to, in Altium units. 223 | ' @param xLocation (Integer) The y-location of the to set the parameter to, in Altium units. 224 | Function SetSchCompParamLocation(schComp, paramName, xLocation, yLocation) 225 | Dim paramIterator 226 | paramIterator = schComp.SchIterator_Create 227 | paramIterator.AddFilter_ObjectSet(MkSet(eParameter)) 228 | 229 | Dim param 230 | ' Iterate through the component's parameters until we find the one whose name matches paramName 231 | param = paramIterator.FirstSchObject 232 | Do Until param Is Nothing 233 | If param.Name = paramName Then 234 | 235 | ' We have found the correct parameter 236 | 'ShowMessage("Setting parameter '" + paramName + "' of '" + schComp.Designator.Text + "' to xLocation = '" + CStr(xLocation) + "', yLocation = '" + CStr(yLocation) + "'.") 237 | 238 | ' NOTE: We have to create a TLocation object! We can't just go param.Location.X = xLocation, e.t.c, this does NOT work!!! 239 | Dim location1 240 | location1 = TLocation 241 | location1.X = xLocation 242 | location1.Y = yLocation 243 | 244 | ' Start of schematic modifiation 245 | Call SchServer.RobotManager.SendMessage(param.I_ObjectAddress, c_BroadCast, SCHM_BeginModify, c_NoEventData) 246 | param.Location = location1 247 | ' Notify the schematic server of the change (so we can save) 248 | Call SchServer.RobotManager.SendMessage(param.I_ObjectAddress, c_BroadCast, SCHM_EndModify, c_NoEventData) 249 | End If 250 | Set param = paramIterator.NextSchObject 251 | Loop 252 | 253 | ' Get rid of the iterator 254 | schComp.SchIterator_Destroy(paramIterator) 255 | End Function 256 | -------------------------------------------------------------------------------- /src/Schematic/SwapSchematicDesignators.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file SwapSchematicDesignators.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2015-09-11 5 | ' @last-modified 2015-09-11 6 | ' @brief Script allows user to quickly switch two designators on the schematics 7 | ' (useful for when adjusting PCB layout) 8 | ' @details 9 | ' See README.rst in repo root dir for more info. 10 | 11 | ' Forces us to explicitly define all variables before using them 12 | Option Explicit 13 | 14 | Private ModuleName 15 | ModuleName = "SwapSchematicDesignators.vbs" 16 | 17 | ' @brief Allows the user to quickly switch two components on a PCB. 18 | ' @param dummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 19 | Sub SwapSchematicDesignators(dummyVar) 20 | 21 | ' Obtain the schematic server interface. 22 | If SchServer Is Nothing Then 23 | ShowMessage("ERROR: Schematic server not online." + VbLf + VbCr) 24 | Exit Sub 25 | End If 26 | 27 | ' Get current (active) schematic 28 | Dim currentSch 29 | currentSch = SchServer.GetCurrentSchDocument 30 | If currentSch Is Nothing Then 31 | ShowMessage("ERROR: The current active document (if any) is not a schematic." + VbLf + VbCr) 32 | Exit Sub 33 | End If 34 | 35 | ' Keep going until the user presses exit (the returned object from 36 | ' GetSchComponentFromUser() will be nothing 37 | while True 38 | 39 | '============ 1st COMPONENT ============' 40 | 41 | Dim firstComponent 42 | 43 | Do 44 | Set firstComponent = GetSchComponentFromUser(currentSch, "Choose source component.") 45 | 46 | If firstComponent Is Nothing Then 47 | Exit Sub 48 | End If 49 | 50 | If Not firstComponent.ObjectId = eSchComponent Then 51 | ShowMessage("ERROR: Selected object is not a schematic component! Press ESC to quit.") 52 | 'Exit Sub 53 | End If 54 | Loop While Not firstComponent.ObjectId = eSchComponent 55 | 56 | 'ShowMessage("component.Location.X = '" + CStr(firstComponent.Location.X) + "'.") 57 | 58 | '============ 2nd COMPONENT ============' 59 | 60 | Dim secondComponent 61 | 62 | Do 63 | Set secondComponent = GetSchComponentFromUser(currentSch, "Choose destination component.") 64 | 65 | If secondComponent Is Nothing Then 66 | Exit Sub 67 | End If 68 | 69 | If Not secondComponent.ObjectId = eSchComponent Then 70 | ShowMessage("ERROR: Selected object is not a schematic component! Press ESC to quit.") 71 | End If 72 | Loop While Not secondComponent.ObjectId = eSchComponent 73 | 74 | '=============== PERFORM THE DESIGNATOR SWAP ==================' 75 | 76 | 'ShowMessage("Source designator = " + firstComponent.Designator.Text) 77 | 78 | ' Save one of the designators in local variable 79 | Dim secondComponentDesignator 80 | secondComponentDesignator = secondComponent.Designator.Text 81 | 82 | ' Start of undo block 83 | Call SchServer.ProcessControl.PreProcess(currentSch, "") 84 | 'Call SchServer.RobotManager.SendMessage(currentSch.I_ObjectAddress, c_BroadCast, SCHM_StartModify, c_NoEventData) 85 | 86 | ' Actual swap occurs below (schematic modifications occur) 87 | secondComponent.Designator.Text = firstComponent.Designator.Text 88 | firstComponent.Designator.Text = secondComponentDesignator 89 | 90 | ' End of undo block 91 | Call SchServer.ProcessControl.PostProcess(currentSch, "") 92 | Call SchServer.RobotManager.SendMessage(currentSch.I_ObjectAddress, c_BroadCast, SCHM_EndModify, c_NoEventData) 93 | 94 | Wend 95 | 96 | End Sub 97 | -------------------------------------------------------------------------------- /src/Stats/Stats.dfm: -------------------------------------------------------------------------------- 1 | object FormStats: TFormStats 2 | Left = 0 3 | Top = 0 4 | Caption = 'PCB Stats' 5 | ClientHeight = 512 6 | ClientWidth = 417 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Label2: TLabel 17 | Left = 26 18 | Top = 33 19 | Width = 87 20 | Height = 13 21 | Caption = 'Num. Normal Vias:' 22 | end 23 | object LabelNumNormalVias: TLabel 24 | Left = 202 25 | Top = 33 26 | Width = 6 27 | Height = 13 28 | Caption = '0' 29 | end 30 | object Label1: TLabel 31 | Left = 26 32 | Top = 113 33 | Width = 194 34 | Height = 13 35 | Caption = 'Num. of Pads With Circular Plated Holes:' 36 | end 37 | object LabelNumOfPadsWithCircularPlatedHoles: TLabel 38 | Left = 242 39 | Top = 113 40 | Width = 6 41 | Height = 13 42 | Caption = '0' 43 | end 44 | object Label3: TLabel 45 | Left = 26 46 | Top = 145 47 | Width = 218 48 | Height = 13 49 | Caption = 'Total Num. of Circular Holes (incl. vias):' 50 | Font.Charset = DEFAULT_CHARSET 51 | Font.Color = clWindowText 52 | Font.Height = -11 53 | Font.Name = 'Tahoma' 54 | Font.Style = [fsBold] 55 | ParentFont = False 56 | end 57 | object LabelTotalNumOfCircularHoles: TLabel 58 | Left = 266 59 | Top = 145 60 | Width = 7 61 | Height = 13 62 | Caption = '0' 63 | Font.Charset = DEFAULT_CHARSET 64 | Font.Color = clWindowText 65 | Font.Height = -11 66 | Font.Name = 'Tahoma' 67 | Font.Style = [fsBold] 68 | ParentFont = False 69 | end 70 | object Label4: TLabel 71 | Left = 26 72 | Top = 321 73 | Width = 115 74 | Height = 13 75 | Caption = 'Min. Annular Ring (mm):' 76 | end 77 | object LabelMinAnnularRingMm: TLabel 78 | Left = 154 79 | Top = 321 80 | Width = 6 81 | Height = 13 82 | Caption = '0' 83 | end 84 | object Label5: TLabel 85 | Left = 26 86 | Top = 353 87 | Width = 111 88 | Height = 13 89 | Caption = 'Min. Track Width (mm):' 90 | end 91 | object LabelMinTrackWidthMm: TLabel 92 | Left = 154 93 | Top = 353 94 | Width = 6 95 | Height = 13 96 | Caption = '0' 97 | end 98 | object Label6: TLabel 99 | Left = 26 100 | Top = 369 101 | Width = 102 102 | Height = 13 103 | Caption = 'Num. Copper Layers:' 104 | end 105 | object LabelNumCopperLayers: TLabel 106 | Left = 154 107 | Top = 369 108 | Width = 6 109 | Height = 13 110 | Caption = '0' 111 | end 112 | object Label7: TLabel 113 | Left = 26 114 | Top = 401 115 | Width = 189 116 | Height = 13 117 | Caption = 'Board Width (bounding rectangle, mm):' 118 | end 119 | object Label8: TLabel 120 | Left = 26 121 | Top = 417 122 | Width = 192 123 | Height = 13 124 | Caption = 'Board Height (bounding rectangle, mm):' 125 | end 126 | object LabelBoardWidthMm: TLabel 127 | Left = 234 128 | Top = 401 129 | Width = 6 130 | Height = 13 131 | Caption = '0' 132 | end 133 | object LabelBoardHeightMm: TLabel 134 | Left = 234 135 | Top = 417 136 | Width = 6 137 | Height = 13 138 | Caption = '0' 139 | end 140 | object Label9: TLabel 141 | Left = 26 142 | Top = 289 143 | Width = 151 144 | Height = 13 145 | Caption = 'Number of Different Hole Sizes:' 146 | end 147 | object LabelNumDiffHoleSizes: TLabel 148 | Left = 186 149 | Top = 289 150 | Width = 6 151 | Height = 13 152 | Caption = '0' 153 | end 154 | object Label10: TLabel 155 | Left = 26 156 | Top = 433 157 | Width = 198 158 | Height = 13 159 | Caption = 'Board Area (bounding rectangle, mm^2):' 160 | end 161 | object LabelBoardAreaMm: TLabel 162 | Left = 234 163 | Top = 433 164 | Width = 6 165 | Height = 13 166 | Caption = '0' 167 | end 168 | object Label11: TLabel 169 | Left = 26 170 | Top = 129 171 | Width = 207 172 | Height = 13 173 | Caption = 'Num. of Pads With Circular Unplated Holes:' 174 | end 175 | object LabelNumOfPadsWithCircularUnplatedHoles: TLabel 176 | Left = 242 177 | Top = 129 178 | Width = 6 179 | Height = 13 180 | Caption = '0' 181 | end 182 | object Label12: TLabel 183 | Left = 26 184 | Top = 273 185 | Width = 113 186 | Height = 13 187 | Caption = 'Largest Hole Size (mm):' 188 | end 189 | object Label13: TLabel 190 | Left = 26 191 | Top = 257 192 | Width = 116 193 | Height = 13 194 | Caption = 'Smallest Hole Size (mm):' 195 | end 196 | object LabelLargestHoleSizeMm: TLabel 197 | Left = 186 198 | Top = 273 199 | Width = 6 200 | Height = 13 201 | Caption = '0' 202 | end 203 | object LabelSmallestHoleSizeMm: TLabel 204 | Left = 186 205 | Top = 257 206 | Width = 6 207 | Height = 13 208 | Caption = '0' 209 | end 210 | object Label14: TLabel 211 | Left = 26 212 | Top = 49 213 | Width = 76 214 | Height = 13 215 | Caption = 'Num. Blind Vias:' 216 | end 217 | object LabelNumBlindVias: TLabel 218 | Left = 202 219 | Top = 49 220 | Width = 6 221 | Height = 13 222 | Caption = '0' 223 | end 224 | object Label20: TLabel 225 | Left = 26 226 | Top = 65 227 | Width = 84 228 | Height = 13 229 | Caption = 'Num. Buried Vias:' 230 | end 231 | object LabelNumBuriedVias: TLabel 232 | Left = 202 233 | Top = 65 234 | Width = 6 235 | Height = 13 236 | Caption = '0' 237 | end 238 | object Label15: TLabel 239 | Left = 26 240 | Top = 81 241 | Width = 104 242 | Height = 13 243 | Caption = 'Total Num. Of Vias:' 244 | Font.Charset = DEFAULT_CHARSET 245 | Font.Color = clWindowText 246 | Font.Height = -11 247 | Font.Name = 'Tahoma' 248 | Font.Style = [fsBold] 249 | ParentFont = False 250 | end 251 | object LabelTotalNumOfVias: TLabel 252 | Left = 202 253 | Top = 81 254 | Width = 6 255 | Height = 13 256 | Caption = '0' 257 | end 258 | object Label16: TLabel 259 | Left = 26 260 | Top = 169 261 | Width = 192 262 | Height = 13 263 | Caption = 'Num. of Pads With Slotted Plated Holes:' 264 | end 265 | object Label17: TLabel 266 | Left = 26 267 | Top = 185 268 | Width = 205 269 | Height = 13 270 | Caption = 'Num. of Pads With Slotted Unplated Holes:' 271 | end 272 | object Label18: TLabel 273 | Left = 26 274 | Top = 201 275 | Width = 155 276 | Height = 13 277 | Caption = 'Total Num. of Slotted Holes:' 278 | Font.Charset = DEFAULT_CHARSET 279 | Font.Color = clWindowText 280 | Font.Height = -11 281 | Font.Name = 'Tahoma' 282 | Font.Style = [fsBold] 283 | ParentFont = False 284 | end 285 | object Label19: TLabel 286 | Left = 26 287 | Top = 225 288 | Width = 233 289 | Height = 13 290 | Caption = 'Total Num. of Holes (circular and slotted):' 291 | Font.Charset = DEFAULT_CHARSET 292 | Font.Color = clWindowText 293 | Font.Height = -11 294 | Font.Name = 'Tahoma' 295 | Font.Style = [fsBold] 296 | ParentFont = False 297 | end 298 | object LabelNumOfPadsWithSlottedPlatedHoles: TLabel 299 | Left = 250 300 | Top = 169 301 | Width = 6 302 | Height = 13 303 | Caption = '0' 304 | end 305 | object LabelNumOfPadsWithSlottedUnplatedHoles: TLabel 306 | Left = 250 307 | Top = 185 308 | Width = 6 309 | Height = 13 310 | Caption = '0' 311 | end 312 | object LabelTotalNumOfSlottedHoles: TLabel 313 | Left = 250 314 | Top = 201 315 | Width = 6 316 | Height = 13 317 | Caption = '0' 318 | end 319 | object LabelTotalNumOfHoles: TLabel 320 | Left = 282 321 | Top = 225 322 | Width = 7 323 | Height = 13 324 | Caption = '0' 325 | Font.Charset = DEFAULT_CHARSET 326 | Font.Color = clWindowText 327 | Font.Height = -11 328 | Font.Name = 'Tahoma' 329 | Font.Style = [fsBold] 330 | ParentFont = False 331 | end 332 | object Label21: TLabel 333 | Left = 26 334 | Top = 337 335 | Width = 92 336 | Height = 13 337 | Caption = 'Max. Aspect Ratio:' 338 | end 339 | object labelMaxAspectRatio: TLabel 340 | Left = 154 341 | Top = 337 342 | Width = 6 343 | Height = 13 344 | Caption = '0' 345 | end 346 | end 347 | -------------------------------------------------------------------------------- /src/Tools/AddSpecialSchParams.dfm: -------------------------------------------------------------------------------- 1 | object FormAddSpecialSchParams: TFormAddSpecialSchParams 2 | Left = 0 3 | Top = 0 4 | Caption = 'Script Central' 5 | ClientHeight = 247 6 | ClientWidth = 442 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Label1: TLabel 17 | Left = 26 18 | Top = 28 19 | Width = 380 20 | Height = 39 21 | Caption = 'Add Special Parameters' 22 | Font.Charset = DEFAULT_CHARSET 23 | Font.Color = clWindowText 24 | Font.Height = -32 25 | Font.Name = 'Tahoma' 26 | Font.Style = [fsBold] 27 | ParentFont = False 28 | end 29 | object Label2: TLabel 30 | Left = 77 31 | Top = 221 32 | Width = 310 33 | Height = 13 34 | Caption = 35 | 'Parameters will be added to all schematics in the current projec' + 36 | 't.' 37 | end 38 | object CbDocumentName: TCheckBox 39 | Left = 41 40 | Top = 98 41 | Width = 97 42 | Height = 17 43 | Caption = 'DocumentName' 44 | TabOrder = 0 45 | end 46 | object CbProjectName: TCheckBox 47 | Left = 41 48 | Top = 146 49 | Width = 97 50 | Height = 17 51 | Caption = 'ProjectName' 52 | TabOrder = 1 53 | end 54 | object CbModifiedDate: TCheckBox 55 | Left = 41 56 | Top = 122 57 | Width = 97 58 | Height = 17 59 | Caption = 'ModifiedDate' 60 | TabOrder = 2 61 | end 62 | object ButAdd: TButton 63 | Left = 76 64 | Top = 190 65 | Width = 75 66 | Height = 25 67 | Caption = 'Add' 68 | TabOrder = 3 69 | OnClick = ButAddClick 70 | end 71 | end 72 | -------------------------------------------------------------------------------- /src/Tools/AddSpecialSchParams.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file AddSpecialSchParams.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2015-04-30 6 | ' @brief Adds special schematic parameters. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' @brief Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | ' @brief Name of this module. Used for debugging/warning/error message purposes. 14 | Private Const moduleName = "AddSpecialSchParams.vbs" 15 | 16 | ' @param DummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 17 | Sub AddSpecialSchParams(dummyVar) 18 | 19 | 'ShowMessage("Adding special schematic parameters...") 20 | 21 | ' Show this form 22 | FormAddSpecialSchParams.Show 23 | 24 | End Sub 25 | 26 | ' @brief Event handler for the "Add" button. 27 | ' @details Called when "Add" button is clicked. 28 | Sub ButAddClick(sender) 29 | 30 | If CbDocumentName.Checked = True Then 31 | Call AddSchParam("DocumentName", "") 32 | End If 33 | 34 | If CbModifiedDate.Checked = True Then 35 | Call AddSchParam("ModifiedDate", "") 36 | End If 37 | 38 | If CbProjectName.Checked = True Then 39 | Call AddSchParam("ProjectName", "") 40 | End If 41 | 42 | ' Close this form 43 | FormAddSpecialSchParams.Close 44 | 45 | ShowMessage("Special schematic parameters added." + VbCr + VbLf) 46 | 47 | End Sub 48 | 49 | ' @brief Adds a parameter given a name/value to all schematics in the currently active project. 50 | ' @param paramName The name of the parameter to add. 51 | ' @param paramValue The value of the parameter to add. 52 | Sub AddSchParam(paramName, paramValue) 53 | 54 | 'Call ShowMessage("Name = " + paramName) 55 | 56 | ' Obtain the schematic server interface. 57 | If SchServer Is Nothing Then 58 | ShowMessage("ERROR: Schematic server not online." + VbLf + VbCr) 59 | Exit Sub 60 | End If 61 | 62 | ' Get pcb project interface 63 | Dim workspace 64 | Set workspace = GetWorkspace 65 | 66 | Dim pcbProject 67 | Set pcbProject = workspace.DM_FocusedProject 68 | 69 | If pcbProject Is Nothing Then 70 | ShowMessage("ERROR: Current project is not a PCB project." + VbLf + VbCr) 71 | Exit Sub 72 | End If 73 | 74 | ' COMPILE PROJECT 75 | 76 | ResetParameters 77 | Call AddStringParameter("Action", "Compile") 78 | Call AddStringParameter("ObjectKind", "Project") 79 | Call RunProcess("WorkspaceManager:Compile") 80 | 81 | ' 2015-04-30: Diabled the flatHierarchy checking bit so 82 | ' that we could perform this operation on a .SchDot file being 83 | ' edited from the vault 84 | 'Dim flatHierarchy 85 | 'Set flatHierarchy = PCBProject.DM_DocumentFlattened 86 | 87 | ' If we couldn't get the flattened sheet, then most likely the project has 88 | ' not been compiled recently 89 | 'If flatHierarchy Is Nothing Then 90 | ' ShowMessage("ERROR: Compile the project before running this script.") 91 | ' Exit Sub 92 | 'End If 93 | 94 | ' Loop through all project documents 95 | Dim docNum 96 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 97 | Dim document 98 | Set document = pcbProject.DM_LogicalDocuments(docNum) 99 | 100 | ' If this is SCH document 101 | If document.DM_DocumentKind = "SCH" Then 102 | Dim sheet 103 | Set sheet = SCHServer.GetSchDocumentByPath(document.DM_FullPath) 104 | 'ShowMessage(document.DM_FullPath); 105 | If sheet Is Nothing Then 106 | ShowMessage("ERROR: Sheet '" + document.DM_FullPath + "' could not be retrieved." + VbCr + VbLf) 107 | Exit Sub 108 | End If 109 | 110 | ' Start of undo block 111 | Call SchServer.ProcessControl.PreProcess(sheet, "") 112 | 113 | 'Dim projParameter 114 | 'Set projParameter = pcbProject.DM_Parameters(paramNum) 115 | 116 | ' CHECK IF PARAMETER ALREADY EXISTS 117 | 118 | ' Set up iterator to look for parameter objects only 119 | Dim paramIterator 120 | Set paramIterator = sheet.SchIterator_Create 121 | If paramIterator Is Nothing Then 122 | ShowMessage("ERROR: Iterator could not be created.") 123 | Exit Sub 124 | End If 125 | 126 | paramIterator.AddFilter_ObjectSet(MkSet(eParameter)) 127 | Dim schParameters 128 | Set schParameters = paramIterator.FirstSchObject 129 | 130 | Call SchServer.RobotManager.SendMessage(sheet.I_ObjectAddress, c_BroadCast, SCHM_BeginModify, c_NoEventData) 131 | 132 | ' Iterate through exising parameters 133 | Do While Not (schParameters Is Nothing) 134 | If schParameters.Name = paramName Then 135 | ' Remove parameter before adding again 136 | sheet.RemoveSchObject(schParameters) 137 | 'ShowMessage("Calling robot.") 138 | 'Call SchServer.RobotManager.SendMessage(sheet.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, schParameters.I_ObjectAddress) 139 | 'Call SchServer.RobotManager.SendMessage(null, null, 1, schParameters.I_ObjectAddress) 140 | 'ShowMessage("Finished robot.") 141 | End If 142 | 143 | Set schParameters = paramIterator.NextSchObject 144 | Loop 145 | 146 | sheet.SchIterator_Destroy(paramIterator) 147 | 148 | ' NOW ADD PARAMETER TO SCHEMATIC 149 | 150 | Dim newParam 151 | newParam = SchServer.SchObjectFactory(eParameter, eCreate_Default) 152 | newParam.Name = paramName 153 | newParam.Text = paramValue 154 | sheet.AddSchObject(newParam) 155 | 156 | ' Redraw schematic sheet 157 | sheet.GraphicallyInvalidate 158 | 159 | ' Tell server about change 160 | Call SchServer.RobotManager.SendMessage(sheet.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, newParam.I_ObjectAddress) 161 | Call SchServer.RobotManager.SendMessage(sheet.I_ObjectAddress, c_BroadCast, SCHM_EndModify, c_NoEventData) 162 | 163 | ' End of undo block 164 | Call SchServer.ProcessControl.PostProcess(sheet, "") 165 | 166 | End If ' If document.DM_DocumentKind = "SCH" Then 167 | Next ' For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 168 | 169 | End Sub 170 | -------------------------------------------------------------------------------- /src/Tools/CurrentCalculator.dfm: -------------------------------------------------------------------------------- 1 | object FormCurrentCalculator: TFormCurrentCalculator 2 | Left = 0 3 | Top = 0 4 | Caption = 'Current Calculator' 5 | ClientHeight = 367 6 | ClientWidth = 288 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object LabelTrackThicknessUmText: TLabel 17 | Left = 16 18 | Top = 30 19 | Width = 104 20 | Height = 13 21 | Caption = 'Track Thickness (um):' 22 | end 23 | object LabelTrackThicknessUm: TLabel 24 | Left = 200 25 | Top = 30 26 | Width = 12 27 | Height = 13 28 | Caption = '35' 29 | end 30 | object LabelTrackWidthMmTitle: TLabel 31 | Left = 16 32 | Top = 46 33 | Width = 88 34 | Height = 13 35 | Caption = 'Track Width (mm):' 36 | end 37 | object LabelTrackWidthMm: TLabel 38 | Left = 200 39 | Top = 46 40 | Width = 16 41 | Height = 13 42 | Caption = '0.4' 43 | end 44 | object LabelTrackLayerTitle: TLabel 45 | Left = 16 46 | Top = 62 47 | Width = 60 48 | Height = 13 49 | Caption = 'Track Layer:' 50 | end 51 | object LabelTrackLayer: TLabel 52 | Left = 200 53 | Top = 62 54 | Width = 40 55 | Height = 13 56 | Caption = 'External' 57 | end 58 | object LabelTrackCrossSectionalAreaMm2Title: TLabel 59 | Left = 16 60 | Top = 78 61 | Width = 173 62 | Height = 13 63 | Caption = 'Track Cross-sectional Area (mm^2):' 64 | end 65 | object LabelTrackCrosssectionalAreaMm2: TLabel 66 | Left = 200 67 | Top = 78 68 | Width = 28 69 | Height = 13 70 | Caption = '0.008' 71 | end 72 | object Label7: TLabel 73 | Left = 16 74 | Top = 278 75 | Width = 111 76 | Height = 16 77 | Caption = 'Max Current (A):' 78 | Font.Charset = DEFAULT_CHARSET 79 | Font.Color = clWindowText 80 | Font.Height = -13 81 | Font.Name = 'Tahoma' 82 | Font.Style = [fsBold] 83 | ParentFont = False 84 | end 85 | object LabelMaxCurrentA: TLabel 86 | Left = 200 87 | Top = 278 88 | Width = 30 89 | Height = 16 90 | Caption = '1.2A' 91 | Font.Charset = DEFAULT_CHARSET 92 | Font.Color = clWindowText 93 | Font.Height = -13 94 | Font.Name = 'Tahoma' 95 | Font.Style = [fsBold] 96 | ParentFont = False 97 | end 98 | object Label8: TLabel 99 | Left = 16 100 | Top = 254 101 | Width = 111 102 | Height = 13 103 | Caption = 'Allowed Temp Rise (C):' 104 | end 105 | object LabelViaFinishedHoleDiameterMmTitle: TLabel 106 | Left = 16 107 | Top = 118 108 | Width = 157 109 | Height = 13 110 | Caption = 'Via Finished Hole Diameter (mm):' 111 | end 112 | object LabelViaHeightMmTitle: TLabel 113 | Left = 16 114 | Top = 166 115 | Width = 79 116 | Height = 13 117 | Caption = 'Via Height (mm):' 118 | end 119 | object LabelViaStartLayerTitle: TLabel 120 | Left = 16 121 | Top = 134 122 | Width = 75 123 | Height = 13 124 | Caption = 'Via Start Layer:' 125 | end 126 | object LabelViaStopLayerTitle: TLabel 127 | Left = 16 128 | Top = 150 129 | Width = 73 130 | Height = 13 131 | Caption = 'Via Stop Layer:' 132 | end 133 | object LabelViaFinishedHoleDiameterMm: TLabel 134 | Left = 200 135 | Top = 118 136 | Width = 16 137 | Height = 13 138 | Caption = '0.2' 139 | end 140 | object LabelViaStartLayer: TLabel 141 | Left = 200 142 | Top = 134 143 | Width = 48 144 | Height = 13 145 | Caption = 'Top Layer' 146 | end 147 | object LabelViaStopLayer: TLabel 148 | Left = 200 149 | Top = 150 150 | Width = 64 151 | Height = 13 152 | Caption = 'Bottom Layer' 153 | end 154 | object LabelViaHeightMm: TLabel 155 | Left = 200 156 | Top = 166 157 | Width = 16 158 | Height = 13 159 | Caption = '1.6' 160 | end 161 | object LabelViaPlatingThicknessUmTitle: TLabel 162 | Left = 16 163 | Top = 182 164 | Width = 127 165 | Height = 13 166 | Caption = 'Via Plating Thickness (um):' 167 | end 168 | object LabelViaCrossSectionalAreaMm2Title: TLabel 169 | Left = 16 170 | Top = 206 171 | Width = 161 172 | Height = 13 173 | Caption = 'Via Cross-sectional Area (mm^2):' 174 | end 175 | object LabelViaCrossSectionalAreaMm2: TLabel 176 | Left = 200 177 | Top = 206 178 | Width = 28 179 | Height = 13 180 | Caption = '0.002' 181 | end 182 | object EditAllowedTempRise: TEdit 183 | Left = 195 184 | Top = 251 185 | Width = 69 186 | Height = 21 187 | TabOrder = 0 188 | Text = '20' 189 | OnChange = EditAllowedTempRiseChange 190 | end 191 | object ButtonFindAnotherTrack: TButton 192 | Left = 82 193 | Top = 313 194 | Width = 134 195 | Height = 25 196 | Caption = 'Find Another Track/Via' 197 | TabOrder = 1 198 | OnClick = ButtonFindAnotherTrackClick 199 | end 200 | object EditViaPlatingThicknessUm: TEdit 201 | Left = 198 202 | Top = 180 203 | Width = 66 204 | Height = 21 205 | TabOrder = 2 206 | Text = '35' 207 | end 208 | end 209 | -------------------------------------------------------------------------------- /src/Tools/DeleteSchematicParameters.dfm: -------------------------------------------------------------------------------- 1 | object FormDeleteSchematicParameters: TFormDeleteSchematicParameters 2 | Left = 0 3 | Top = 0 4 | Caption = 'Delete Schematic Parameters' 5 | ClientHeight = 311 6 | ClientWidth = 406 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Label1: TLabel 17 | Left = 74 18 | Top = 80 19 | Width = 84 20 | Height = 13 21 | Caption = 'Parameter Name:' 22 | end 23 | object RadioGroupWhichSchematics: TRadioGroup 24 | Left = 29 25 | Top = 152 26 | Width = 283 27 | Height = 105 28 | Caption = 'From Which Schematics?' 29 | ItemIndex = 0 30 | Items.Strings = ( 31 | 'Delete From Active Schematic' 32 | 'Delete From All Schematics Of Active Project') 33 | TabOrder = 4 34 | end 35 | object RadioGroupWhichParameters: TRadioGroup 36 | Left = 29 37 | Top = 24 38 | Width = 283 39 | Height = 121 40 | Caption = 'Which Parameters?' 41 | ItemIndex = 0 42 | Items.Strings = ( 43 | 'Delete Specific Parameter' 44 | 'Delete All Parameters') 45 | TabOrder = 3 46 | end 47 | object TEditParameterName: TEdit 48 | Left = 165 49 | Top = 77 50 | Width = 121 51 | Height = 21 52 | TabOrder = 0 53 | Text = 'DrawnBy' 54 | end 55 | object ButtonExit: TButton 56 | Left = 300 57 | Top = 266 58 | Width = 75 59 | Height = 25 60 | Caption = 'Exit' 61 | TabOrder = 1 62 | OnClick = ButtonExit_Click 63 | end 64 | object ButtonDelete: TButton 65 | Left = 212 66 | Top = 266 67 | Width = 75 68 | Height = 25 69 | Caption = 'Delete' 70 | TabOrder = 2 71 | OnClick = ButtonDelete_Click 72 | end 73 | end 74 | -------------------------------------------------------------------------------- /src/Tools/DeleteSchematicParameters.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file DeleteSchematicParameters.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2015-04-30 6 | ' @brief Deletes a user-selectable range of schematic parameters in the current project. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | ' @brief Name of this module. Used for debugging/warning/error message purposes and for 14 | ' saving user data. 15 | Private Const moduleName = "DeleteSchematicParameters.vbs" 16 | 17 | ' @brief Enables/disables debug information. 18 | Private DEBUG 19 | DEBUG = 0 20 | 21 | '===== CONSTANTS =====' 22 | 23 | Const DELETE_SPECIFIC_PARAMETER = 0 24 | Const DELETE_ALL_PARAMETERS = 1 25 | 26 | Const DELETE_FROM_ACTIVE_SCHEMATIC = 0 27 | Const DELETE_FROM_ALL_SCHEMATICS_IN_ACTIVE_PROJECT = 1 28 | 29 | '===== SUBROUTINES/FUNCTIONS =====' 30 | 31 | ' @brief Deletes all schematic parameters. 32 | ' @param DummyVar Dummy variable so that this sub does not show up to the user when 33 | ' they click "Run Script". 34 | Sub DeleteSchematicParameters(dummyVar) 35 | FormDeleteSchematicParameters.ShowModal 36 | End Sub 37 | 38 | ' @brief Event handler for when the Delete button is clicked. 39 | ' @details Gets the user input, validates it, then deletes the required parameters from 40 | ' one or many schematic sheets of the current project. 41 | Sub ButtonDelete_Click(Sender) 42 | 'ShowMessage("Deleting schematic parameters...") 43 | 44 | ' Obtain the schematic server interface. 45 | If SchServer Is Nothing Then 46 | ShowMessage("ERROR: Schematic server not online." + VbLf + VbCr) 47 | Exit Sub 48 | End If 49 | 50 | ' Get pcb project interface 51 | Dim workspace 52 | Set workspace = GetWorkspace 53 | 54 | Dim pcbProject 55 | Set pcbProject = workspace.DM_FocusedProject 56 | 57 | If pcbProject Is Nothing Then 58 | PrintDebug("ERROR: Current project is not a PCB project." + VbLf + VbCr) 59 | Exit Sub 60 | End If 61 | 62 | ' COMPILE PROJECT 63 | 64 | Call ResetParameters 65 | Call AddStringParameter("Action", "Compile") 66 | Call AddStringParameter("ObjectKind", "Project") 67 | Call RunProcess("WorkspaceManager:Compile") 68 | 69 | Dim flatHierarchy 70 | Set flatHierarchy = pcbProject.DM_DocumentFlattened 71 | 72 | ' If we couldn't get the flattened sheet, then most likely the project has 73 | ' not been compiled recently 74 | 'If flatHierarchy Is Nothing Then 75 | 'ShowMessage("ERROR: Compile the project before running this script." + VbCr + VbLf) 76 | 'Exit Sub 77 | 'End If 78 | 79 | Dim schematicCount 80 | schematicCount = 0 81 | 82 | Dim paramCount 83 | paramCount = 0 84 | 85 | Dim schematic 86 | 87 | ' Check if we only need to delete from the currently active schematic 88 | If RadioGroupWhichSchematics.ItemIndex = DELETE_FROM_ACTIVE_SCHEMATIC Then 89 | PrintDebug("Deleting from active schematic.") 90 | 91 | ' Get active schematic 92 | schematic = SCHServer.GetCurrentSchDocument() 93 | If schematic Is Nothing Then 94 | ShowMessage("ERROR: There is no active schematic.") 95 | Exit Sub 96 | End If 97 | 98 | Dim paramCountTemp 99 | If RadioGroupWhichParameters.ItemIndex = DELETE_SPECIFIC_PARAMETER Then 100 | PrintDebug("Deleting specific parameter.") 101 | paramCountTemp = DeleteParametersFromSchematic(schematic, DELETE_SPECIFIC_PARAMETER, TEditParameterName.Text) 102 | 103 | If paramCountTemp = 0 Then 104 | ShowMessage("ERROR: Parameter '" + TEditParameterName.Text + "' was not found on schematic.") 105 | End If 106 | 107 | ' Increment the actual parameter count 108 | paramCount = paramCount + paramCountTemp 109 | 110 | ElseIf RadioGroupWhichParameters.ItemIndex = DELETE_ALL_PARAMETERS Then 111 | PrintDebug("Deleting all parameters.") 112 | paramCountTemp = DeleteParametersFromSchematic(schematic, DELETE_ALL_PARAMETERS, TEditParameterName.Text) 113 | 114 | If paramCountTemp = 0 Then 115 | ShowMessage("ERROR: No parameters were found on schematic.") 116 | End If 117 | 118 | ' Increment the actual parameter count 119 | paramCount = paramCount + paramCountTemp 120 | 121 | Else 122 | ShowMessage("ERROR: Value of RadioGroupWhichParameters.ItemIndex was out of range.") 123 | End If 124 | 125 | schematicCount = schematicCount + 1 126 | 127 | ElseIf RadioGroupWhichSchematics.ItemIndex = DELETE_FROM_ALL_SCHEMATICS_IN_ACTIVE_PROJECT Then 128 | 129 | 130 | ' Loop through all project documents 131 | Dim docNum 132 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 133 | Dim document 134 | Set document = pcbProject.DM_LogicalDocuments(DocNum) 135 | 136 | ' Check to see if this is SCH document 137 | If document.DM_DocumentKind = "SCH" Then 138 | 139 | ' Cool, it is a schematic, lets open it and then delete parameter(s) from it! 140 | 141 | ' 2015-08-10, gbmhunter: Added this next line so that this script can work even if the 142 | ' schematics are not open in Altium 143 | Call Client.OpenDocument("SCH", document.DM_FullPath) 144 | 145 | Set schematic = SCHServer.GetSchDocumentByPath(document.DM_FullPath) 146 | 'ShowMessage(document.DM_FullPath); 147 | If schematic Is Nothing Then 148 | ShowMessage("ERROR: Sheet '" + Document.DM_FullPath + "' could not be retrieved." + VbCr + VbLf) 149 | Exit Sub 150 | End If 151 | 152 | If RadioGroupWhichParameters.ItemIndex = DELETE_SPECIFIC_PARAMETER Then 153 | PrintDebug("Deleting specific parameter.") 154 | paramCount = paramCount + DeleteParametersFromSchematic(schematic, DELETE_SPECIFIC_PARAMETER, TEditParameterName.Text) 155 | ElseIf RadioGroupWhichParameters.ItemIndex = DELETE_ALL_PARAMETERS Then 156 | PrintDebug("Deleting all parameters.") 157 | paramCount = paramCount + DeleteParametersFromSchematic(schematic, DELETE_ALL_PARAMETERS, TEditParameterName.Text) 158 | Else 159 | ShowMessage("ERROR: Value of RadioGroupWhichParameters.ItemIndex was out of range.") 160 | End If 161 | 162 | ' Increment sheet count 163 | schematicCount = schematicCount + 1 164 | 165 | End If ' If document.DM_DocumentKind = "SCH" Then 166 | Next ' For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 167 | Else 168 | ShowMessage("ERROR: Value of RadioGroupWhichSchematics.ItemIndex was out of range.") 169 | End If 170 | 171 | ShowMessage("Deleted '" + CStr(paramCount) + "' parameter(s) from '" + CStr(schematicCount) + "' schematic(s).") 172 | 173 | ' Finished deleting parameters, will can now close the form 174 | FormDeleteSchematicParameters.Close 175 | 176 | End Sub 177 | 178 | ' @brief Deletes one or all parameters from the provided schematic. 179 | ' @param paramName The name of the parameter to delete if deleteOneOrAll = DELETE_SPECIFIC_PARAMETER. 180 | ' If deleteOneOrAll = DELETE_ALL_PARAMETERS this variable is not used. 181 | ' @returns The number of parameters deleted from the schematic. 182 | Function DeleteParametersFromSchematic(schematic, deleteOneOrAll, paramName) 183 | 184 | 185 | PrintDebug("DeleteParametersFromSchematic() called with schematic = '" + schematic.DocumentName + "', deleteOneOrAll = '" + CStr(deleteOneOrAll) + "', paramName = '" + paramName + "'.") 186 | 187 | ' Start of undo block 188 | Call SchServer.ProcessControl.PreProcess(schematic, "") 189 | 190 | Dim deletedParamCount 191 | deletedParamCount = 0 192 | 193 | '===== DELETE SCHEMATIC PARAMETERS =====' 194 | 195 | ' Set up iterator to look for parameter objects only 196 | Dim paramIterator 197 | Set paramIterator = schematic.SchIterator_Create 198 | If paramIterator Is Nothing Then 199 | ShowMessage("ERROR: Iterator could not be created.") 200 | Exit Function 201 | End If 202 | 203 | paramIterator.AddFilter_ObjectSet(MkSet(eParameter)) 204 | Dim schParameter 205 | Set schParameter = ParamIterator.FirstSchObject 206 | 207 | Call SchServer.RobotManager.SendMessage(schematic.I_ObjectAddress, c_BroadCast, SCHM_BeginModify, c_NoEventData) 208 | 209 | ' Iterate through schematic parameters and delete them 210 | Do While Not (schParameter Is Nothing) 211 | 212 | ' Call SchServer.RobotManager.SendMessage(document.I_ObjectAddress, c_BroadCast, SCHM_BeginModify, c_NoEventData) 213 | 'If schParameter.IsSystemParameter = True Then 214 | ' ShowMessage("Parameter '" + schParameter.Name + "' is system parameter.") 215 | 'End If 216 | 217 | 'StdOut("Calling robot.") 218 | 'Call SchServer.RobotManager.SendMessage(sheet.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, schParameters.I_ObjectAddress) 219 | 'Call SchServer.RobotManager.SendMessage(null, null, 1, schParameters.I_ObjectAddress) 220 | 'StdOut("Finished robot.") 221 | 222 | If deleteOneOrAll = DELETE_SPECIFIC_PARAMETER Then 223 | ' Make sure we only delete the requested parameter! 224 | 'ShowMessage("Only deleting the one parameter '" + paramName + "' from schematic '" + schematic.DocumentName + ".") 225 | If schParameter.Name = paramName Then 226 | PrintDebug("Removing parameter '" + schParameter.Name + "'.") 227 | schematic.RemoveSchObject(schParameter) 228 | Call SchServer.RobotManager.SendMessage(schematic.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, schParameter.I_ObjectAddress) 229 | 230 | deletedParamCount = deletedParamCount + 1 231 | 232 | End If 233 | ElseIf deleteOneOrAll = DELETE_FROM_ALL_SCHEMATICS_IN_ACTIVE_PROJECT Then 234 | 'ShowMessage("Removing parameter '" + schParameter.Name + "'.") 235 | schematic.RemoveSchObject(schParameter) 236 | deletedParamCount = deletedParamCount + 1 237 | Else ' If RadioGroupWhichSchematic.ItemIndex = DELETE_FROM_ALL_SCHEMATICS_IN_ACTIVE_PROJECT Then 238 | ShowMessage("ERROR: Invalid value for variable deleteOneOrAll.") 239 | End If 240 | 241 | 242 | Set schParameter = paramIterator.NextSchObject 243 | Loop 244 | 245 | schematic.SchIterator_Destroy(paramIterator) 246 | 247 | Call SchServer.RobotManager.SendMessage(schematic.I_ObjectAddress, c_BroadCast, SCHM_EndModify, c_NoEventData) 248 | 249 | ' End of undo block 250 | Call SchServer.ProcessControl.PostProcess(schematic, "") 251 | 252 | ' Redraw schematic sheet 253 | schematic.GraphicallyInvalidate 254 | 255 | ' Return the number of deleted parameters 256 | DeleteParametersFromSchematic = deletedParamCount 257 | 258 | End Function 259 | 260 | Sub ButtonExit_Click(Sender) 261 | FormDeleteSchematicParameters.Close 262 | End Sub 263 | 264 | Private Sub PrintDebug(msg) 265 | If DEBUG = 1 Then 266 | ShowMessage(msg) 267 | End If 268 | End Sub 269 | 270 | -------------------------------------------------------------------------------- /src/Tools/DrawPolygon.dfm: -------------------------------------------------------------------------------- 1 | object FormDrawPolygon: TFormDrawPolygon 2 | Left = 0 3 | Top = 0 4 | Caption = 'Draw Polygon' 5 | ClientHeight = 548 6 | ClientWidth = 575 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object LabelRotationDeg: TLabel 17 | Left = 33 18 | Top = 313 19 | Width = 74 20 | Height = 13 21 | Caption = 'Rotation (deg):' 22 | end 23 | object LabelLineThickness: TLabel 24 | Left = 33 25 | Top = 121 26 | Width = 99 27 | Height = 13 28 | Caption = 'Line Thickness (mm):' 29 | end 30 | object Label2: TLabel 31 | Left = 33 32 | Top = 385 33 | Width = 59 34 | Height = 13 35 | Caption = 'Draw Layer:' 36 | end 37 | object Label1: TLabel 38 | Left = 33 39 | Top = 49 40 | Width = 61 41 | Height = 13 42 | Caption = 'Num. Edges:' 43 | end 44 | object EditVertexRadiusMm: TEdit 45 | Left = 148 46 | Top = 166 47 | Width = 121 48 | Height = 21 49 | TabOrder = 0 50 | Text = '10' 51 | end 52 | object EditRotationDeg: TEdit 53 | Left = 148 54 | Top = 310 55 | Width = 121 56 | Height = 21 57 | TabOrder = 1 58 | Text = '0' 59 | end 60 | object ButtonDrawOnPcb: TButton 61 | Left = 107 62 | Top = 427 63 | Width = 165 64 | Height = 25 65 | Caption = 'Draw On PCB' 66 | TabOrder = 2 67 | OnClick = ButtonDrawOnPcbClick 68 | end 69 | object EditLineThicknessMm: TEdit 70 | Left = 148 71 | Top = 118 72 | Width = 121 73 | Height = 21 74 | TabOrder = 3 75 | Text = '0.2' 76 | end 77 | object Memo1: TMemo 78 | Left = 283 79 | Top = 115 80 | Width = 250 81 | Height = 42 82 | Lines.Strings = ( 83 | 'The desired thickness (in mm) of the lines the ' 84 | 'hexagon will be drawn with.') 85 | TabOrder = 4 86 | end 87 | object Memo2: TMemo 88 | Left = 283 89 | Top = 163 90 | Width = 250 91 | Height = 42 92 | Lines.Strings = ( 93 | 'The radius (in mm) of a theoretical circle that ' 94 | 'touches all of the hexagon'#39's verticies.') 95 | TabOrder = 5 96 | end 97 | object Memo3: TMemo 98 | Left = 283 99 | Top = 307 100 | Width = 250 101 | Height = 63 102 | Lines.Strings = ( 103 | 'The clockwise rotation (in degrees) that the ' 104 | 'hexagon will be drawn at. An angle of 0 is when ' 105 | 'one of the hexagon sides is horizontal and at the ' 106 | 'top of the shape.') 107 | TabOrder = 6 108 | end 109 | object ButtonCancel: TButton 110 | Left = 315 111 | Top = 427 112 | Width = 165 113 | Height = 25 114 | Caption = 'Cancel' 115 | TabOrder = 7 116 | OnClick = ButtonCancelClick 117 | end 118 | object EditDrawLayer: TEdit 119 | Left = 148 120 | Top = 382 121 | Width = 121 122 | Height = 21 123 | TabOrder = 8 124 | Text = 'Top Layer' 125 | end 126 | object Memo4: TMemo 127 | Left = 283 128 | Top = 379 129 | Width = 250 130 | Height = 21 131 | Lines.Strings = ( 132 | 'PCB layer to draw the hexagon onto.') 133 | TabOrder = 9 134 | end 135 | object RadioButtonVertexRadiusMm: TRadioButton 136 | Left = 15 137 | Top = 167 138 | Width = 113 139 | Height = 17 140 | Caption = 'Vertex Radius (mm):' 141 | Checked = True 142 | TabOrder = 10 143 | TabStop = True 144 | end 145 | object RadioButtonEdgeRadiusMm: TRadioButton 146 | Left = 15 147 | Top = 215 148 | Width = 113 149 | Height = 17 150 | Caption = 'Edge Radius (mm):' 151 | TabOrder = 11 152 | end 153 | object EditEdgeRadiusMm: TEdit 154 | Left = 148 155 | Top = 214 156 | Width = 121 157 | Height = 21 158 | TabOrder = 12 159 | Text = '10' 160 | end 161 | object Memo5: TMemo 162 | Left = 283 163 | Top = 211 164 | Width = 250 165 | Height = 42 166 | Lines.Strings = ( 167 | 'The radius (in mm) of a theoretical circle that ' 168 | 'touches all of the hexagon'#39's edges.') 169 | TabOrder = 13 170 | end 171 | object EditNumEdges: TEdit 172 | Left = 148 173 | Top = 46 174 | Width = 121 175 | Height = 21 176 | TabOrder = 14 177 | Text = '6' 178 | end 179 | object Memo6: TMemo 180 | Left = 283 181 | Top = 43 182 | Width = 250 183 | Height = 63 184 | Lines.Strings = ( 185 | 'The number of edges you wish the polygon to ' 186 | 'have (e.g. 3 for a triangle, 4 for a square, 8 for ' 187 | 'an octagon). Must be equal to or greater than 3.') 188 | TabOrder = 15 189 | end 190 | object RadioButtonEdgeLengthMm: TRadioButton 191 | Left = 15 192 | Top = 263 193 | Width = 113 194 | Height = 17 195 | Caption = 'Edge Length (mm):' 196 | TabOrder = 16 197 | end 198 | object EditEdgeLengthMm: TEdit 199 | Left = 148 200 | Top = 262 201 | Width = 121 202 | Height = 21 203 | TabOrder = 17 204 | Text = '10' 205 | end 206 | object Memo7: TMemo 207 | Left = 283 208 | Top = 259 209 | Width = 250 210 | Height = 42 211 | Lines.Strings = ( 212 | 'The length of one of the edges of the polygon.') 213 | TabOrder = 18 214 | end 215 | end 216 | -------------------------------------------------------------------------------- /src/Tools/DrawPolygon.vbs: -------------------------------------------------------------------------------- 1 | ' ' 2 | ' @file DrawPolygon.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2014-11-11 5 | ' @last-modified 2015-09-28 6 | ' @brief Script draws a polygon made from tracks. 7 | ' Ability to specify the number of edges, track width, rotation, e.t.c. 8 | ' @details 9 | ' See README.rst in repo root dir for more info. 10 | 11 | ' Forces us to explicitly define all variables before using them 12 | Option Explicit 13 | 14 | ' @brief Used to store board object. 15 | Private Board 16 | 17 | ' @param DummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 18 | Sub DrawPolygon(DummyVar) 19 | 20 | ' Set Locale to Austria 21 | 'SetLocale(3079) 22 | 23 | ' Load current board 24 | If PCBServer Is Nothing Then 25 | ShowMessage("ERROR: Not a PCB or footprint editor activated.") 26 | End If 27 | 28 | Set board = PCBServer.GetCurrentPCBBoard 29 | If board Is Nothing Then 30 | ShowMessage("ERROR: Not a PCB or footprint loaded.") 31 | Exit Sub 32 | End If 33 | 34 | ' Get the current PCB layer and populate field on UI 35 | EditDrawLayer.Text = Layer2String(Board.CurrentLayer) 36 | 37 | ' Display form 38 | FormDrawPolygon.Show 39 | End Sub 40 | 41 | Sub ButtonDrawOnPcbClick(Sender) 42 | 43 | '======================================================' 44 | '========== RETRIEVE AND VALIDATE USER INPUT ==========' 45 | '======================================================' 46 | 47 | Dim numEdges 48 | numEdges = EditNumEdges.Text 49 | ' Validate 50 | If Not IsInt(numEdges) Then 51 | ShowMessage("ERROR: 'Num. Edges' input must be an integer") 52 | Exit Sub 53 | End If 54 | 55 | If numEdges < 3 Then 56 | ShowMessage("ERROR: 'Num. Edges' input must be equal to or greater than 3.") 57 | Exit Sub 58 | End If 59 | 60 | Dim vertexRadiusSelected 61 | Dim edgeRadiusSelected 62 | Dim edgeLengthSelected 63 | 64 | ' Get values of radio buttons, only one of these should be checked 65 | vertexRadiusSelected = RadioButtonVertexRadiusMm.Checked 66 | edgeRadiusSelected = RadioButtonEdgeRadiusMm.Checked 67 | edgeLengthSelected = RadioButtonEdgeLengthMm.Checked 68 | 69 | If vertexRadiusSelected Then 70 | If Not IsPerfectlyNumeric(EditVertexRadiusMm.Text) Then 71 | ShowMessage("ERROR: 'Vertex Radius (mm)' input must be a valid number.") 72 | Exit Sub 73 | End If 74 | If CDbl(EditVertexRadiusMm.Text) <= 0 Then 75 | ShowMessage("ERROR: 'Vertex Radius (mm)' input must be greater than 0.") 76 | Exit Sub 77 | End If 78 | ElseIf edgeRadiusSelected Then 79 | If Not IsPerfectlyNumeric(EditEdgeRadiusMm.Text) Then 80 | ShowMessage("ERROR: 'Edge Radius (mm)' input must be a valid number.") 81 | Exit Sub 82 | End If 83 | If CDbl(EditEdgeRadiusMm.Text) <= 0 Then 84 | ShowMessage("ERROR: 'Edge Radius (mm)' input must be greater than 0.") 85 | Exit Sub 86 | End If 87 | ElseIf edgeLengthSelected Then 88 | If Not IsPerfectlyNumeric(EditEdgeLengthMm.Text) Then 89 | ShowMessage("ERROR: 'Edge Length (mm)' input must be a valid number.") 90 | Exit Sub 91 | End If 92 | If CDbl(EditEdgeLengthMm.Text) <= 0 Then 93 | ShowMessage("ERROR: 'Edge Length (mm)' input must be greater than 0.") 94 | Exit Sub 95 | End If 96 | End If 97 | 98 | ' Rotation 99 | If Not IsPerfectlyNumeric(EditRotationDeg.Text) Then 100 | ShowMessage("ERROR: 'Rotation' input must be a valid number.") 101 | Exit Sub 102 | End If 103 | Dim rotationDeg 104 | rotationDeg = StrToFloat(EditRotationDeg.Text) 105 | 106 | ' Line thickness 107 | If Not IsPerfectlyNumeric(EditLineThicknessMm.Text) Then 108 | ShowMessage("ERROR: 'Line Thickness (mm)' input must be a valid number.") 109 | Exit Sub 110 | End If 111 | Dim lineThicknessMm 112 | lineThicknessMm = StrToFloat(EditLineThicknessMm.Text) 113 | If lineThicknessMm < 0 Then 114 | ShowMessage("ERROR: 'Line Thickness (mm)' input must be greater than 0.") 115 | Exit Sub 116 | End If 117 | 118 | Dim layer 119 | ' Convert the string to a valid Altium layer 120 | layer = String2Layer(EditDrawLayer.Text) 121 | If layer = 0 Then 122 | ' Show error msg, close "DrawPolygon" form and exit 123 | ShowMessage("ERROR: '" + EditDrawLayer.Text + "' in 'Draw Layer' box is not a valid layer!") 124 | 'FormDrawPolygon.Close 125 | Exit Sub 126 | End If 127 | 'ShowMessage("Layer = " + CStr(Layer)) 128 | 129 | ' Get the Pi constant, note that VB script has no built-in constant 130 | ' so this is one of the best ways to do it. 131 | Dim Pi 132 | Pi = 4 * Atn(1) 133 | 134 | ' Get user to choose where the centre of the hexeagon is going to go 135 | Dim xm, ym 136 | Call board.ChooseLocation(xm, ym, "Select the centre of the hexagon.") 137 | 138 | ' Initialise systems 139 | Call PCBServer.PreProcess 140 | 141 | ' Calculate the sector angle. This is the angle a single sector of the polygon encompasses, as 142 | ' measured around the origin of the polygon. 143 | Dim sectorAngle 144 | sectorAngle = 360.0/numEdges 145 | 146 | ' Get first points, this depends on the method choosen to define the 147 | ' polygon's size 148 | Dim vertexRadiusMm 149 | Dim edgeRadiusMm 150 | Dim EdgeLengthMm 151 | Dim x1 152 | Dim y1 153 | Dim x2 154 | Dim y2 155 | If vertexRadiusSelected Then 156 | vertexRadiusMm = CDbl(EditVertexRadiusMm.Text) 157 | x1 = -vertexRadiusMm * sin((sectorAngle/2)*Pi/180) 158 | y1 = vertexRadiusMm * cos((sectorAngle/2)*Pi/180) 159 | 160 | x2 = vertexRadiusMm * sin((sectorAngle/2)*Pi/180) 161 | y2 = vertexRadiusMm * cos((sectorAngle/2)*Pi/180) 162 | ElseIf edgeRadiusSelected Then 163 | edgeRadiusMm = CDbl(EditEdgeRadiusMm.Text) 164 | x1 = -edgeRadiusMm * tan((SectorAngle/2)*Pi/180) 165 | y1 = edgeRadiusMm 166 | 167 | x2 = edgeRadiusMm * tan((SectorAngle/2)*Pi/180) 168 | y2 = edgeRadiusMm 169 | ElseIf edgeLengthSelected Then 170 | edgeLengthMm = CDbl(EditEdgeLengthMm.Text) 171 | x1 = -edgeLengthMm/2 172 | y1 = edgeLengthMm/(2*tan((SectorAngle/2)*Pi/180)) 173 | 174 | x2 = edgeLengthMm/2 175 | y2 = edgeLengthMm/(2*tan((SectorAngle/2)*Pi/180)) 176 | End If 177 | 178 | ' Perform initial rotation as user specified 179 | Dim newX1, newY1, newX2, newY2 180 | newX1 = x1*cos(RotationDeg*Pi/180) + y1*sin(RotationDeg*Pi/180) 181 | newY1 = -x1*sin(RotationDeg*Pi/180) + y1*cos(RotationDeg*Pi/180) 182 | 183 | newX2 = x2*cos(RotationDeg*Pi/180) + y2*sin(RotationDeg*Pi/180) 184 | newY2 = -x2*sin(RotationDeg*Pi/180) + y2*cos(RotationDeg*Pi/180) 185 | 186 | x1 = newX1 187 | y1 = newY1 188 | x2 = newX2 189 | y2 = newY2 190 | 191 | 192 | ' Create each track seperately 193 | Dim index 194 | For index = 0 To (NumEdges - 1) 195 | 196 | ' Create a new track object 197 | Dim track 198 | track = PCBServer.PCBObjectFactory(eTrackObject, eNoDimension, eCreate_Default) 199 | 200 | 'ShowMessage("x1 = " + CStr(x1) + ", y1 = " + CStr(y1)) 201 | 202 | ' Place track in correct position 203 | track.x1 = xm + MMsToCoord(x1) 204 | track.y1 = ym + MMsToCoord(y1) 205 | 206 | track.x2 = xm + MMsToCoord(x2) 207 | track.y2 = ym + MMsToCoord(y2) 208 | 209 | track.Width = MMsToCoord(LineThicknessMm) 210 | track.Layer = Layer 211 | 212 | ' Add track to PCB 213 | board.AddPCBObject(Track) 214 | 215 | ' Rotate points for next iteration of loop 216 | newX1 = x1*cos(SectorAngle*Pi/180) + y1*sin(SectorAngle*Pi/180) 217 | newY1 = -x1*sin(SectorAngle*Pi/180) + y1*cos(SectorAngle*Pi/180) 218 | 219 | newX2 = x2*cos(SectorAngle*Pi/180) + y2*sin(SectorAngle*Pi/180) 220 | newY2 = -x2*sin(SectorAngle*Pi/180) + y2*cos(SectorAngle*Pi/180) 221 | 222 | x1 = newX1 223 | y1 = newY1 224 | x2 = newX2 225 | y2 = newY2 226 | 227 | Next 228 | 229 | ' Refresh the PCB screen 230 | Call Client.SendMessage("PCB:Zoom", "Action=Redraw" , 255, Client.CurrentView) 231 | 232 | ' Update the undo System in DXP that a new vIa object has been added to the board 233 | Call PCBServer.SendMessageToRobots(Board.I_ObjectAddress, c_Broadcast, PCBM_BoardRegisteration, Track.I_ObjectAddress) 234 | 235 | ' Initialise systems 236 | Call PCBServer.PostProcess 237 | 238 | ' Close form 239 | FormDrawPolygon.Close 240 | 241 | End Sub 242 | 243 | Sub ButtonCancelClick(Sender) 244 | ' Close form 245 | FormDrawPolygon.Close 246 | End Sub 247 | -------------------------------------------------------------------------------- /src/Tools/ExitActiveCommand.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file ExitActiveCommand.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2015-01-16 5 | ' @last-modified 2015-01-16 6 | ' @brief Main entry point for AltiumScriptCentral. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private ModuleName 14 | ModuleName = "ExitActiveCommand.vbs" 15 | 16 | Sub ExitActiveCommand(DummyVar) 17 | PCBServer.PostProcess 18 | End Sub 19 | -------------------------------------------------------------------------------- /src/Tools/NumberSchematics.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file NumberSchematics.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2015-01-22 6 | ' @brief Numbers all schematic sheets for the current project. Designed to work 7 | ' with a schematic template which displays the sheet number and total sheets 8 | ' on the schematic. 9 | ' @details 10 | ' See README.rst in repo root dir for more info. 11 | 12 | ' Forces us to explicitly define all variables before using them 13 | Option Explicit 14 | 15 | ' @brief The name of this module for logging purposes 16 | Private moduleName 17 | moduleName = "NumberSchematics.vbs" 18 | 19 | ' @brief Numbers all schematic sheets for the current project. 20 | ' @param DummyVar Dummy variable so that this sub does not show up to the user when 21 | ' they click "Run Script". 22 | Sub NumberSchematics(dummyVar) 23 | 24 | 'StdOut("Numbering schematics...") 25 | 26 | ' Obtain the schematic server interface. 27 | If SchServer Is Nothing Then 28 | ShowMessage("ERROR: Schematic server not online.") 29 | Exit Sub 30 | End If 31 | 32 | ' Get pcb project interface 33 | Dim workspace ' As IWorkspace 34 | Set workspace = GetWorkspace 35 | 36 | Dim pcbProject ' As IProject 37 | Set pcbProject = workspace.DM_FocusedProject 38 | 39 | If pcbProject Is Nothing Then 40 | ShowMessage("ERROR: Current project is not a PCB project") 41 | Exit Sub 42 | End If 43 | 44 | ' COMPILE PROJECT 45 | 46 | ResetParameters 47 | Call AddStringParameter("Action", "Compile") 48 | Call AddStringParameter("ObjectKind", "Project") 49 | Call RunProcess("WorkspaceManager:Compile") 50 | 51 | Set flatHierarchy = PCBProject.DM_DocumentFlattened 52 | 53 | ' If we couldn't get the flattened sheet, then most likely the project has 54 | ' not been compiled recently 55 | Dim flatHierarchy ' As IDocument 56 | If flatHierarchy Is Nothing Then 57 | ShowMessage("ERROR: Compile the project before running this script.") 58 | Exit Sub 59 | End If 60 | 61 | Dim totalSheetCount ' As Integer 62 | totalSheetCount = 0 63 | 64 | ' COUNT SCHEMATIC SHEETS 65 | 66 | ' Loop through all project documents to count schematic sheets 67 | Dim docNum ' As Integer 68 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 69 | Dim document ' As IDocument 70 | Set document = pcbProject.DM_LogicalDocuments(docNum) 71 | 72 | ' If this is SCH document 73 | If document.DM_DocumentKind = "SCH" Then 74 | Dim sheet ' As ISch_Document 75 | Set sheet = SCHServer.GetSchDocumentByPath(document.DM_FullPath) 76 | If sheet Is Nothing Then 77 | ShowMessage("ERROR: Sheet '" + document.DM_FullPath + "' could not be retrieved." + VbCr + VbLf) 78 | Exit Sub 79 | End If 80 | ' Increment count 81 | totalSheetCount = totalSheetCount + 1 82 | End If ' If document.DM_DocumentKind = "SCH" Then 83 | Next 84 | 85 | ' ADD SCHEMATIC NUMBER AND TOTAL COUNT 86 | Dim schematicSheetCount ' As Integer 87 | schematicSheetCount = 0 88 | 89 | ' Now loop through all project documents again to number sheets 90 | ' Note that if we use the default ordering, they are guaranteed to be numbered 91 | ' as laid out in the "Projects" window. This is confusing. 92 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 93 | Set document = pcbProject.DM_LogicalDocuments(docNum) 94 | 95 | ' If this is SCH document 96 | If document.DM_DocumentKind = "SCH" Then 97 | Set sheet = SCHServer.GetSchDocumentByPath(document.DM_FullPath) 98 | 'ShowMessage(document.DM_FullPath); 99 | If sheet Is Nothing Then 100 | ShowMessage("ERROR: No sheet found." + VbCr + VbLf) 101 | Exit Sub 102 | End If 103 | 104 | ' Increment sheet count 105 | schematicSheetCount = schematicSheetCount + 1 106 | 107 | ' Start of undo block 108 | Call SchServer.ProcessControl.PreProcess(sheet, "") 109 | 110 | '===== REMOVE EXISTING PARAMETERS IF THEY EXIST =====' 111 | 112 | ' Set up iterator to look for parameter objects only 113 | Dim paramIterator 114 | Set paramIterator = sheet.SchIterator_Create 115 | If paramIterator Is Nothing Then 116 | ShowMessage("ERROR: Iterator could not be created.") 117 | Exit Sub 118 | End If 119 | 120 | ' Set up iterator mask 121 | paramIterator.AddFilter_ObjectSet(MkSet(eParameter)) 122 | 123 | Dim schParameters 124 | Set schParameters = paramIterator.FirstSchObject 125 | 126 | ' Iterate through exising parameters 127 | Do While Not (schParameters Is Nothing) 128 | ' Look for sheet count or total count parameters 129 | If schParameters.Name = SCHEMATIC_SHEET_COUNT_PARAM_NAME Or schParameters.Name = TOTAL_SHEET_PARAM_NAME Then 130 | ' Remove parameter before adding again 131 | sheet.RemoveSchObject(schParameters) 132 | Call SchServer.RobotManager.SendMessage(sheet.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, schParameters.I_ObjectAddress) 133 | End If 134 | 135 | Set schParameters = paramIterator.NextSchObject 136 | Loop 137 | 138 | sheet.SchIterator_Destroy(paramIterator) 139 | 140 | '===== ADDING NEW PARAMETERS =====' 141 | 142 | ' Add schematic sheet number and total count as parameters 143 | 144 | Dim sheetCountParam 145 | sheetCountParam = SchServer.SchObjectFactory(eParameter, eCreate_Default) 146 | sheetCountParam.Name = SCHEMATIC_SHEET_COUNT_PARAM_NAME 147 | sheetCountParam.Text = schematicSheetCount 148 | sheet.AddSchObject(sheetCountParam) 149 | 150 | ' Tell server about change 151 | Call SchServer.RobotManager.SendMessage(sheet.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, sheetCountParam.I_ObjectAddress) 152 | 153 | Dim totalSheetsParam 154 | totalSheetsParam = SchServer.SchObjectFactory(eParameter, eCreate_Default) 155 | totalSheetsParam.Name = TOTAL_SHEET_PARAM_NAME 156 | totalSheetsParam.Text = totalSheetCount 157 | sheet.AddSchObject(totalSheetsParam) 158 | 159 | ' Tell server about change 160 | Call SchServer.RobotManager.SendMessage(sheet.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, totalSheetsParam.I_ObjectAddress) 161 | 162 | ' End of undo block 163 | Call SchServer.ProcessControl.PostProcess(sheet, "") 164 | 165 | End If ' If document.DM_DocumentKind = "SCH" Then 166 | Next ' For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 167 | 168 | ShowMessage("Schematic numbers have been added to '" + CStr(totalSheetCount) + "' sheets.") 169 | 170 | End Sub 171 | -------------------------------------------------------------------------------- /src/Tools/PushProjectParametersToSchematics.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file PushProjectParametersToSchematics.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2015-01-14 6 | ' @brief Copies project parameters and pastes them as schematic parameters in every schematic in the project. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | ' @brief The name of this module for logging purposes 14 | Private moduleName 15 | moduleName = "PushProjectParametersToSchematics.vbs" 16 | 17 | 18 | ' @brief Copies project parameters and pastes them as schematic parameters in every schematic in the project. 19 | ' @param DummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 20 | Sub PushProjectParametersToSchematics(DummyVar) 21 | 22 | 'StdOut("Pushing project parameters to schematics...") 23 | 24 | Dim violationFnd 25 | violationFnd = false 26 | 27 | ' Obtain the schematic server interface. 28 | If SchServer Is Nothing Then 29 | ShowMessage("ERROR: Schematic server not online.") 30 | Exit Sub 31 | End If 32 | 33 | ' Get pcb project interface 34 | Dim workspace ' As IWorkspace 35 | Set workspace = GetWorkspace 36 | 37 | Dim pcbProject ' As IProject 38 | Set pcbProject = workspace.DM_FocusedProject 39 | 40 | If pcbProject Is Nothing Then 41 | ShowMessage("ERROR: Current project is not a PCB project.") 42 | Exit Sub 43 | End If 44 | 45 | ' COMPILE PROJECT 46 | 47 | ResetParameters 48 | Call AddStringParameter("Action", "Compile") 49 | Call AddStringParameter("ObjectKind", "Project") 50 | Call RunProcess("WorkspaceManager:Compile") 51 | 52 | Dim flatHierarchy ' As IDocument 53 | Set flatHierarchy = PCBProject.DM_DocumentFlattened 54 | 55 | ' If we couldn't get the flattened sheet, then most likely the project has 56 | ' not been compiled recently 57 | If flatHierarchy Is Nothing Then 58 | ShowMessage("ERROR: Compile the project before running this script.") 59 | Exit Sub 60 | End If 61 | 62 | ' Loop through all project documents 63 | Dim docNum ' As Integer 64 | For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 65 | 66 | Dim document ' As IDocument 67 | Set document = pcbProject.DM_LogicalDocuments(docNum) 68 | 69 | ' If this is SCH document 70 | If document.DM_DocumentKind = "SCH" Then 71 | Dim sheet ' As ISch_Document 72 | Set sheet = SCHServer.GetSchDocumentByPath(document.DM_FullPath) 73 | 'ShowMessage(document.DM_FullPath); 74 | If sheet Is Nothing Then 75 | ShowMessage("ERROR: Sheet '" + document.DM_FullPath + "' could not be retrieved.") 76 | Exit Sub 77 | End If 78 | 79 | ' Start of undo block 80 | Call SchServer.ProcessControl.PreProcess(sheet, "") 81 | 82 | ' Add all project parameters to this schematic 83 | 84 | ' Iterate through all project parameters 85 | Dim paramNum 86 | For paramNum = 0 To pcbProject.DM_ParameterCount - 1 87 | Dim projParameter 88 | Set projParameter = pcbProject.DM_Parameters(paramNum) 89 | 90 | ' CHECK IF PARAMETER ALREADY EXISTS 91 | 92 | ' Set up iterator to look for parameter objects only 93 | Dim paramIterator 94 | Set paramIterator = sheet.SchIterator_Create 95 | If paramIterator Is Nothing Then 96 | ShowMessage("ERROR: Iterator could not be created.") 97 | Exit Sub 98 | End If 99 | 100 | paramIterator.AddFilter_ObjectSet(MkSet(eParameter)) 101 | Dim schParameters 102 | Set schParameters = paramIterator.FirstSchObject 103 | 104 | ' Call SchServer.RobotManager.SendMessage(document.I_ObjectAddress, c_BroadCast, SCHM_BeginModify, c_NoEventData) 105 | 106 | ' Iterate through exising parameters 107 | Do While Not (schParameters Is Nothing) 108 | If schParameters.Name = projParameter.DM_Name Then 109 | ' Remove parameter before adding again 110 | sheet.RemoveSchObject(schParameters) 111 | 'StdOut("Calling robot.") 112 | 'Call SchServer.RobotManager.SendMessage(sheet.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, schParameters.I_ObjectAddress) 113 | 'Call SchServer.RobotManager.SendMessage(null, null, 1, schParameters.I_ObjectAddress) 114 | 'StdOut("Finished robot.") 115 | End If 116 | 117 | Set schParameters = paramIterator.NextSchObject 118 | Loop 119 | 120 | sheet.SchIterator_Destroy(paramIterator) 121 | 122 | ' NOW ADD PROJ PARAMETER TO SCHEMATIC 123 | 124 | Dim newParam 125 | newParam = SchServer.SchObjectFactory(eParameter, eCreate_Default) 126 | newParam.Name = projParameter.DM_Name 127 | newParam.Text = projParameter.DM_Value 128 | sheet.AddSchObject(newParam) 129 | 130 | ' Redraw schematic sheet 131 | sheet.GraphicallyInvalidate 132 | 133 | ' Tell server about change 134 | 'Call SchServer.RobotManager.SendMessage(sheet.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, newParam.I_ObjectAddress) 135 | 'Call SchServer.RobotManager.SendMessage(document.I_ObjectAddress, c_BroadCast, SCHM_EndModify, c_NoEventData) 136 | 137 | Next ' For paramNum = 0 To pcbProject.DM_ParameterCount - 1 138 | 139 | ' End of undo block 140 | Call SchServer.ProcessControl.PostProcess(sheet, "") 141 | 142 | End If ' If document.DM_DocumentKind = "SCH" Then 143 | Next ' For docNum = 0 To pcbProject.DM_LogicalDocumentCount - 1 144 | 145 | ShowMessage("Parameters have been pushed.") 146 | 147 | End Sub 148 | -------------------------------------------------------------------------------- /src/Tools/RenumberPads.dfm: -------------------------------------------------------------------------------- 1 | object FormRenumberPads: TFormRenumberPads 2 | Left = 0 3 | Top = 0 4 | BorderIcons = [biSystemMenu] 5 | Caption = 'Renumber Pads' 6 | ClientHeight = 145 7 | ClientWidth = 298 8 | Color = clBtnFace 9 | DragMode = dmAutomatic 10 | Font.Charset = DEFAULT_CHARSET 11 | Font.Color = clWindowText 12 | Font.Height = -11 13 | Font.Name = 'Tahoma' 14 | Font.Style = [] 15 | OldCreateOrder = False 16 | PopupMode = pmAuto 17 | Position = poScreenCenter 18 | FormKind = fkModal 19 | PixelsPerInch = 96 20 | TextHeight = 13 21 | object GroupBox: TGroupBox 22 | Left = 8 23 | Top = 8 24 | Width = 280 25 | Height = 128 26 | Caption = 'Renumber setup' 27 | TabOrder = 0 28 | object lblFirstPadIndex: TLabel 29 | Left = 32 30 | Top = 29 31 | Width = 73 32 | Height = 13 33 | Caption = 'First Pad Index' 34 | end 35 | object lblPadIncrement: TLabel 36 | Left = 32 37 | Top = 60 38 | Width = 101 39 | Height = 13 40 | Caption = 'Pad Index Increment' 41 | end 42 | object EditFirstPadNumber: TEdit 43 | Left = 160 44 | Top = 24 45 | Width = 81 46 | Height = 21 47 | Alignment = taRightJustify 48 | NumbersOnly = True 49 | TabOrder = 0 50 | Text = '1' 51 | end 52 | object ButtonOk: TButton 53 | Left = 40 54 | Top = 88 55 | Width = 75 56 | Height = 25 57 | Caption = 'OK' 58 | TabOrder = 2 59 | OnClick = ButtonOkClick 60 | end 61 | object ButtonCancel: TButton 62 | Left = 168 63 | Top = 88 64 | Width = 75 65 | Height = 25 66 | Caption = 'Cancel' 67 | TabOrder = 3 68 | OnClick = ButtonCancelClick 69 | end 70 | object EditPadIncrement: TEdit 71 | Left = 160 72 | Top = 56 73 | Width = 81 74 | Height = 21 75 | Alignment = taRightJustify 76 | NumbersOnly = True 77 | TabOrder = 1 78 | Text = '1' 79 | end 80 | end 81 | end 82 | -------------------------------------------------------------------------------- /src/Tools/RenumberPads.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file RenumberPads.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2014-12-08 6 | ' @brief Script allows user to quickly renumber pads on a PCB component 7 | ' by clicking them in order. 8 | ' @details 9 | ' See README.rst in repo root dir for more info. 10 | 11 | Dim Board ' As IPCB_Board 12 | Dim PadObject ' As IPCB_Pad 13 | 14 | ' @brief Call this from AltiumScriptCentral 15 | ' @param DummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 16 | Sub RenumberPads(DummyVar) 17 | ' Show form, non-modal 18 | ' ShowModal won't return until form is closed. 19 | FormRenumberPads.Show 20 | 21 | ' Load current board 22 | If PCBServer Is Nothing Then 23 | ShowMessage("Not a PCB or Footprint editor activated.") 24 | End If 25 | 26 | Set Board = PCBServer.GetCurrentPCBBoard 27 | If Board Is Nothing Then 28 | ShowMessage("Not a PCB or Footprint loaded.") 29 | Exit Sub 30 | End If 31 | End Sub 32 | 33 | Function ButtonOkClick(sender) 34 | 35 | ' Get the requested first index number and 36 | ' increment 37 | PadIndex = StrToInt(EditFirstPadNumber.Text) 38 | PadIncrement = StrToInt(EditPadIncrement.Text) 39 | 40 | ' 2014-11-05: I think the next line is causing bugs, so I have left 41 | ' the form visible 42 | 'FormRenumberPads.Visible = 0 43 | 44 | ' Ask user to select first pad object 45 | Board.ChooseLocation x, y, "Choose a pad." 46 | Set PadObject = Board.GetObjectAtXYAskUserIfAmbiguous(x, y, MkSet(ePadObject), AllLayers, eEditAction_Select) 47 | 48 | Do While Not PadObject Is Nothing 49 | 50 | ' Create undo for each pad index change 51 | Call PCBServer.PreProcess 52 | Call PCBServer.SendMessageToRobots(PadObject.I_ObjectAddress, c_Broadcast, PCBM_BeginModify , c_NoEventData) 53 | 54 | ' Change pad index 55 | PadObject.Name = PadIndex 56 | 57 | ' This here causes the PCB view to refresh, displaying the changed PAD number 58 | Call PCBServer.SendMessageToRobots(PadObject.I_ObjectAddress, c_Broadcast, PCBM_EndModify , c_NoEventData) 59 | Call PCBServer.PostProcess 60 | 61 | ' Increment the pad index 62 | PadIndex = PadIndex + PadIncrement 63 | 64 | ' Ask user to select next pad in infinite loop 65 | Board.ChooseLocation x, y, "Choose a pad." 66 | Set PadObject = board.GetObjectAtXYAskUserIfAmbiguous(x, y, MkSet(ePadObject), AllLayers, eEditAction_Select) 67 | 68 | Loop 69 | 70 | ' Finally, close the form 71 | FormRenumberPads.Close 72 | End Function 73 | 74 | Sub ButtonCancelClick(sender) 75 | ' Close the form 76 | FormRenumberPads.Close 77 | End Sub 78 | -------------------------------------------------------------------------------- /src/Tools/ResizeDesignators.dfm: -------------------------------------------------------------------------------- 1 | object FormResizeDesignators: TFormResizeDesignators 2 | Left = 0 3 | Top = 0 4 | Caption = 'Resize Designators' 5 | ClientHeight = 201 6 | ClientWidth = 304 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Label1: TLabel 17 | Left = 40 18 | Top = 78 19 | Width = 59 20 | Height = 13 21 | Caption = 'Width (mm):' 22 | end 23 | object Label2: TLabel 24 | Left = 40 25 | Top = 46 26 | Width = 62 27 | Height = 13 28 | Caption = 'Height (mm):' 29 | end 30 | object EditWidthMm: TEdit 31 | Left = 115 32 | Top = 75 33 | Width = 121 34 | Height = 21 35 | TabOrder = 0 36 | Text = '0.2' 37 | end 38 | object EditHeightMm: TEdit 39 | Left = 115 40 | Top = 43 41 | Width = 121 42 | Height = 21 43 | TabOrder = 1 44 | Text = '0.7' 45 | end 46 | object ButtonOk: TButton 47 | Left = 50 48 | Top = 152 49 | Width = 75 50 | Height = 25 51 | Caption = 'OK' 52 | TabOrder = 2 53 | OnClick = ButtonOkClick 54 | end 55 | object ButtonCancel: TButton 56 | Left = 170 57 | Top = 152 58 | Width = 75 59 | Height = 25 60 | Caption = 'Cancel' 61 | TabOrder = 3 62 | OnClick = ButtonCancelClick 63 | end 64 | object CheckBoxOnlyModifyDefaultSizedDesignators: TCheckBox 65 | Left = 39 66 | Top = 116 67 | Width = 217 68 | Height = 17 69 | Caption = 'Only modify default-sized designators' 70 | Checked = True 71 | State = cbChecked 72 | TabOrder = 4 73 | end 74 | end 75 | -------------------------------------------------------------------------------- /src/Tools/ResizeDesignators.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file ResizeDesignators.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2013-08-08 5 | ' @last-modified 2016-05-09 6 | ' @brief Code to change the font size of many PCB designators all at once. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private moduleName 14 | moduleName = "ResizeDesignators.vbs" 15 | 16 | ' @brief Called when 'Resize Designators' is called from the main AltiumScriptCentral form. 17 | Function ResizeDesignators(dummyVar) 18 | 19 | ' Get user data if present 20 | 21 | Dim width 22 | width = GetUserData(moduleName, "DesignatorWidth") 23 | If width <> "" Then 24 | EditWidthMm.Text = width 25 | End If 26 | 27 | Dim height 28 | height = GetUserData(moduleName, "DesignatorHeight") 29 | If height <> "" Then 30 | EditHeightMm.Text = height 31 | End If 32 | 33 | ' Show form 34 | FormResizeDesignators.Show 35 | End Function 36 | 37 | Sub ButtonOkClick(Sender) 38 | 39 | Dim Board ' As IPCB_Board 40 | Dim Component 41 | Dim CompDes 42 | 43 | Set Board = PCBServer.GetCurrentPCBBoard 44 | If Board Is Nothing Then 45 | ShowMessage("Could not load current PCB board") 46 | Exit Sub 47 | End If 48 | 49 | '========== VALIDATE INPUTS ==========' 50 | 51 | If Not IsPerfectlyNumeric(EditHeightMm.Text) Then 52 | ShowMessage("ERROR: 'Height' input must be a valid number.") 53 | Exit Sub 54 | End If 55 | 56 | If Not IsPerfectlyNumeric(EditWidthMm.Text) Then 57 | ShowMessage("ERROR: 'Width' input must be a valid number.") 58 | Exit Sub 59 | End If 60 | 61 | 62 | 63 | Dim NumDesignatorsModified 64 | NumDesignatorsModified = 0 65 | 66 | Dim Iterator 67 | Set iterator = board.BoardIterator_Create 68 | iterator.AddFilter_ObjectSet(MkSet(eComponentObject)) 69 | iterator.AddFilter_LayerSet(AllLayers) 70 | iterator.AddFilter_Method(eProcessAll) 71 | 72 | Set compDes = iterator.FirstPCBObject 73 | PCBServer.PreProcess 74 | 75 | Do While Not (CompDes Is Nothing) 76 | Call PCBServer.SendMessageToRobots(CompDes.Name.I_ObjectAddress, c_Broadcast, PCBM_BeginModify, c_NoEventData) 77 | 78 | If CheckBoxOnlyModifyDefaultSizedDesignators.Checked = True Then 79 | If (CompDes.Name.Width = MMsToCoord(0.254)) And (CompDes.Name.Size = MMsToCoord(1.524)) Then 80 | ' Designator IS default sized, so lets change 81 | CompDes.Name.Width = MMsToCoord(EditWidthMm.Text) 82 | CompDes.Name.Size = MMsToCoord(EditHeightMm.Text) 83 | NumDesignatorsModified = NumDesignatorsModified + 1 84 | End If 85 | Else 86 | ' Set the widths/heights 87 | CompDes.Name.Width = MMsToCoord(EditWidthMm.Text) 88 | CompDes.Name.Size = MMsToCoord(EditHeightMm.Text) 89 | NumDesignatorsModified = NumDesignatorsModified + 1 90 | End If 91 | 92 | Call PCBServer.SendMessageToRobots(CompDes.Name.I_ObjectAddress, c_Broadcast, PCBM_EndModify, c_NoEventData) 93 | 94 | Set CompDes = Iterator.NextPCBObject 95 | Loop 96 | 97 | Board.BoardIterator_Destroy(Iterator) 98 | 99 | Pcbserver.PostProcess 100 | 'Pcbserver.PostProcess 101 | Call AddStringParameter("Action", "Redraw") 102 | 'Call RunProcess("PCB:Zoom") 103 | 104 | ShowMessage(CStr(NumDesignatorsModified) + " designators modified.") 105 | 106 | ' Save values for next time 107 | Call SaveUserData(moduleName, "DesignatorWidth", FloatToStr(EditWidthMm.Text)) 108 | Call SaveUserData(moduleName, "DesignatorHeight", FloatToStr(EditHeightMm.Text)) 109 | 110 | ' Finally close the form 111 | FormResizeDesignators.Close 112 | 113 | End Sub 114 | 115 | Sub ButtonCancelClick(Sender) 116 | ' Just close the form 117 | FormResizeDesignators.Close 118 | End Sub 119 | -------------------------------------------------------------------------------- /src/Tools/RotateDesignators.vbs: -------------------------------------------------------------------------------- 1 | Sub RotateDesignators(dummyVar) 2 | Dim board 3 | Dim component 4 | 5 | StdOut("Rotating designators...") 6 | 7 | ' Make sure we are on a PCB 8 | Set board = PCBServer.GetCurrentPCBBoard 9 | If board Is Nothing Then 10 | StdErr("ERROR: Rotating designators failed because PCB board is not active.") 11 | Exit Sub 12 | End If 13 | 14 | ' Set up iterator 15 | Iterator = board.BoardIterator_Create 16 | Iterator.AddFilter_ObjectSet(MkSet(eComponentObject)) 17 | Iterator.AddFilter_LayerSet(AllLayers) 18 | Iterator.AddFilter_Method(eProcessAll) 19 | 20 | ' Get first component 21 | Set component = Iterator.FirstPCBObject 22 | 23 | ' Start of undo block 24 | PCBServer.PreProcess 25 | 26 | While Not (component Is Nothing) 27 | 28 | ' Tell Altium that we are starting modifications 29 | Call PCBServer.SendMessageToRobots(component.Name.I_ObjectAddress, c_Broadcast, PCBM_BeginModify, c_NoEventData) 30 | 31 | If component.Layer = eTopLayer Then 32 | Select Case component.Name.Rotation 33 | Case 180, 360 34 | component.Name.Rotation = 0 35 | Case 270 36 | component.Name.Rotation = 90 37 | End Select 38 | Else 39 | Select Case component.Name.Rotation 40 | Case 180, 360 41 | component.Name.Rotation = 0 42 | Case 90 43 | component.Name.Rotation = 270 44 | End Select 45 | End If 46 | 47 | ' Tell Altium that we have finished the modifications 48 | Call PCBServer.SendMessageToRobots(component.Name.I_ObjectAddress, c_Broadcast, PCBM_EndModify , c_NoEventData) 49 | 50 | ' Get next component 51 | Set component = Iterator.NextPCBObject 52 | Wend 53 | 54 | board.BoardIterator_Destroy(Iterator) 55 | 56 | ' End of undo block 57 | Pcbserver.PostProcess 58 | 59 | ' Finishing commands 60 | Call AddStringParameter("Action", "Redraw") 61 | RunProcess("PCB:Zoom") 62 | 63 | StdOut("Designator rotation finished.") 64 | 65 | End Sub 66 | -------------------------------------------------------------------------------- /src/Tools/SwapComponents.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 201 6 | ClientWidth = 304 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | end 17 | -------------------------------------------------------------------------------- /src/Tools/SwapComponents.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file SwapComponents.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2014-12-08 5 | ' @last-modified 2014-12-22 6 | ' @brief Script allows user to quickly switch two components on a PCB. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Private ModuleName 14 | ModuleName = "SwapComponents.vbs" 15 | 16 | ' @brief Allows the user to quickly switch two components on a PCB. 17 | ' @param DummyVar Dummy variable to stop function appearing in the Altium "Run Script" dialogue. 18 | Sub SwapComponents(DummyVar) 19 | 20 | Set Board = PCBServer.GetCurrentPCBBoard 21 | If Board is Nothing Then 22 | ShowMessage("ERROR: PCB board could not be found. Please make sure a PCB file has current focus.") 23 | Exit Sub 24 | End If 25 | 26 | Pcbserver.PreProcess 27 | 28 | Dim x 29 | Dim y 30 | 31 | ' Get first component to swap (loop allows user to do many swaps in sequential order) 32 | While Board.ChooseLocation(x,y, "Select first component to swap") = True 33 | 34 | Dim CompA 35 | Set CompA = Board.GetObjectAtXYAskUserIfAmbiguous(_ 36 | x,_ 37 | y,_ 38 | MkSet(eComponentObject),_ 39 | AllLayers,_ 40 | eEditAction_Select) 41 | 42 | ' If no component was selected then exit 43 | If CompA Is Nothing Then 44 | Pcbserver.PostProcess 45 | ShowMessage("ERROR: No component was selected.") 46 | Exit Sub 47 | End If 48 | 49 | ' Get second component to swap 50 | Call Board.ChooseLocation(x,y, "Select second component to swap.") 51 | 52 | Dim CompB 53 | Set CompB = Board.GetObjectAtXYAskUserIfAmbiguous(_ 54 | x,_ 55 | y,_ 56 | MkSet(eComponentObject),_ 57 | AllLayers,_ 58 | eEditAction_Select) 59 | 60 | ' If no component was selected then exit 61 | If CompB Is Nothing Then 62 | Pcbserver.PostProcess 63 | ShowMessage("ERROR: No component was selected.") 64 | Exit Sub 65 | End If 66 | 67 | ' Now lets perform the actual swapping of the components 68 | 69 | ' Create temp vars to hold values of first component 70 | Dim CompX, CompY, CompR, DesX, DesY, DesR 71 | 72 | CompX = CompA.X 73 | CompY = CompA.Y 74 | CompR = CompA.Rotation 75 | DesX = CompA.Name.XLocation 76 | DesY = CompA.Name.YLocation 77 | DesR = CompA.Name.Rotation 78 | 79 | Call PCBServer.SendMessageToRobots(_ 80 | CompA.I_ObjectAddress,_ 81 | c_Broadcast,_ 82 | PCBM_BeginModify,_ 83 | c_NoEventData) 84 | CompA.X = CompB.X 85 | CompA.Y = CompB.Y 86 | CompA.Rotation = CompB.Rotation 87 | CompA.ChangeNameAutoposition = eAutoPos_Manual 88 | Call PCBServer.SendMessageToRobots(_ 89 | CompA.I_ObjectAddress,_ 90 | c_Broadcast,_ 91 | PCBM_EndModify,_ 92 | c_NoEventData) 93 | 94 | Call PCBServer.SendMessageToRobots(_ 95 | CompA.Name.I_ObjectAddress,_ 96 | c_Broadcast,_ 97 | PCBM_BeginModify,_ 98 | c_NoEventData) 99 | CompA.Name.XLocation = CompB.Name.XLocation 100 | CompA.Name.YLocation = CompB.Name.YLocation 101 | CompA.Name.Rotation = CompB.Name.Rotation 102 | Call PCBServer.SendMessageToRobots(_ 103 | CompA.Name.I_ObjectAddress,_ 104 | c_Broadcast,_ 105 | PCBM_EndModify,_ 106 | c_NoEventData) 107 | 108 | Call PCBServer.SendMessageToRobots(_ 109 | CompB.I_ObjectAddress,_ 110 | c_Broadcast,_ 111 | PCBM_BeginModify,_ 112 | c_NoEventData) 113 | CompB.X = CompX 114 | CompB.Y = CompY 115 | CompB.Rotation = CompR 116 | CompB.ChangeNameAutoposition = eAutoPos_Manual 117 | Call PCBServer.SendMessageToRobots(_ 118 | CompB.I_ObjectAddress,_ 119 | c_Broadcast,_ 120 | PCBM_EndModify,_ 121 | c_NoEventData) 122 | 123 | Call PCBServer.SendMessageToRobots(_ 124 | CompB.Name.I_ObjectAddress,_ 125 | c_Broadcast,_ 126 | PCBM_BeginModify,_ 127 | c_NoEventData) 128 | CompB.Name.XLocation = DesX 129 | CompB.Name.YLocation = DesY 130 | CompB.Name.Rotation = DesR 131 | Call PCBServer.SendMessageToRobots(_ 132 | CompB.Name.I_ObjectAddress,_ 133 | c_Broadcast,_ 134 | PCBM_EndModify,_ 135 | c_NoEventData) 136 | 137 | Wend 138 | 139 | Pcbserver.PostProcess 140 | ResetParameters 141 | Call AddStringParameter("Action", "Redraw") 142 | RunProcess("PCB:Zoom") 143 | 144 | End Sub 145 | -------------------------------------------------------------------------------- /src/Tools/ViaStamper.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file ViaStamper.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2014-11-11 5 | ' @last-modified 2015-01-23 6 | ' @brief Script allows user to quickly 'stamp' many copies of a via onto a PCB. 7 | ' Useful when placing GND vias. 8 | ' @details 9 | ' See README.rst in repo root dir for more info. 10 | 11 | ' Forces us to explicitly define all variables before using them 12 | Option Explicit 13 | 14 | ' @brief Stamps (copies) vias to user-selected locations. 15 | ' @details Call this from AltiumScriptCentral. 16 | Sub ViaStamper(DummyVar) 17 | 18 | ' Load current board 19 | If PCBServer Is Nothing Then 20 | ShowMessage("No PCB or footprint editor activated.") 21 | End If 22 | 23 | Dim board 24 | Set board = PCBServer.GetCurrentPCBBoard 25 | If board Is Nothing Then 26 | ShowMessage("No PCB or footprint loaded.") 27 | Exit Sub 28 | End If 29 | 30 | 'ShowMessage("First select via you wish to copy and then click repeatidly to 'stamp'.") 31 | 32 | ' Ask user to select first pad object 33 | Dim x, y 34 | board.ChooseLocation x, y, "Choose a via to copy." 35 | Dim exisVia 36 | Set exisVia = Board.GetObjectAtXYAskUserIfAmbiguous(x, y, MkSet(eViaObject), AllLayers, eEditAction_Select) 37 | 38 | ' Make sure via was valid 39 | If exisVia Is Nothing Then 40 | ShowMessage("ERROR: A via was not selected.") 41 | Exit Sub 42 | End If 43 | 44 | Dim xm, ym 45 | Do While (board.ChooseLocation(xm, ym, "Click to stamp via.") = true) 46 | 47 | ' Initialise systems 48 | Call PCBServer.PreProcess 49 | 50 | ' Create a new via object 51 | Dim newVia 52 | newVia = PCBServer.PCBObjectFactory(eViaObject, eNoDimension, eCreate_Default) 53 | 54 | newVia.Size = exisVia.Size 55 | newVia.HoleSize = exisVia.HoleSize 56 | newVia.LowLayer = exisVia.LowLayer 57 | newVia.HighLayer = exisVia.HighLayer 58 | 59 | ' Copy across "cache" data (testpoint and soldermask settings) 60 | newVia.Cache = exisVia.Cache 61 | 62 | ' Copy across "tenting" data 63 | newVia.IsTenting_Top = exisVia.IsTenting_Top 64 | newVia.IsTenting_Bottom = exisVia.IsTenting_Bottom 65 | 66 | ' Place at selected position 67 | newVia.X = xm 68 | newVia.Y = ym 69 | 70 | ' Copy net name to new via 71 | newVia.Net = exisVia.Net 72 | 73 | board.AddPCBObject(NewVia) 74 | 75 | ' Refresh the PCB screen 76 | Call Client.SendMessage("PCB:Zoom", "Action=Redraw" , 255, Client.CurrentView) 77 | 78 | ' Update the undo System in DXP that a new vIa object has been added to the board 79 | Call PCBServer.SendMessageToRobots(Board.I_ObjectAddress, c_Broadcast, PCBM_BoardRegisteration, NewVia.I_ObjectAddress) 80 | 81 | ' Finalize the PCB editor systems??? 82 | Call PCBServer.PostProcess 83 | 84 | ' Repeat until Esc is hit 85 | Loop 86 | 87 | ' Full PCB system update 88 | board.ViewManager_FullUpdate 89 | Call Client.SendMessage("PCB:Zoom", "Action=Redraw" , 255, Client.CurrentView) 90 | 91 | End Sub 92 | -------------------------------------------------------------------------------- /src/UserData/UserData.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file UserData.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2015-04-23 5 | ' @last-modified 2015-04-23 6 | ' @brief Routines to help us save and retrieve data. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Function SaveUserData(moduleName, key, stringToSave) 14 | 15 | 'ShowMessage("Saving data") 16 | 17 | 'ResetParameters 18 | 'AddStringParameter "Dialog", "FileOpenSave" 19 | 'AddStringParameter "Mode", "1" 20 | 'AddStringParameter "Prompt", "Select a document then click OK" 21 | ''AddStringParameter "FileType1", "Comma Separated Values (*.csv)\|*.csv')" 22 | ' RunProcess "Client:RunCommonDialog" 23 | 24 | Dim path 25 | path = GetUsersHomeFolder(null) + "\" + DEFAULT_FILE_NAME_FOR_USER_DATA + ".ini" 26 | 'ShowMessage("Path = " + path) 27 | 28 | ' Creating INI file. INI files are great for saving 29 | ' config data 30 | ' ShowMessage("Creating INI file...") 31 | Dim iniFile 32 | iniFile = TIniFile.Create(path) 33 | 'iniFile.WriteBool "test1", "test2", true 34 | iniFile.WriteString moduleName, key, stringToSave 35 | 36 | ' File will be closed automatically!!! 37 | 38 | 'RunProcess("Client:RunCommonDialog") 39 | 40 | 'Dim saveDialog 41 | 'saveDialog = TSaveDialog.Create(Application) 42 | 'RunProcess(".Title = ") 43 | 'saveDialog.Title = "Save file" 44 | 45 | 'ShowMessage("Calling .Execute") 46 | 'Dim flag 47 | 'flag = SaveDialog.Execute 48 | 'If flag Is 0 Then 49 | ' Exit Function 50 | 'End If 51 | 52 | 'Dim fileName 53 | 'fileName = SaveDialog.FileName 54 | 55 | End Function 56 | 57 | Function GetUserData(moduleName, key) 58 | 59 | 'ShowMessage("GetString called.") 60 | 61 | Dim path 62 | path = GetUsersHomeFolder(null) + "\" + DEFAULT_FILE_NAME_FOR_USER_DATA + ".ini" 63 | Dim iniFile 64 | iniFile = TIniFile.Create(path) 65 | 'iniFile.WriteBool "test1", "test2", true 66 | Dim stringToRetrieve 67 | 'ShowMessage("Reading key = '" + key + "' from module = '" + moduleName + "'.") 68 | stringToRetrieve = iniFile.ReadString(moduleName, key, "") 69 | 70 | 'ShowMessage("Read string = '" + stringToRetrieve + "'.") 71 | GetUserData = stringToRetrieve 72 | 73 | End Function 74 | 75 | 76 | -------------------------------------------------------------------------------- /src/Util/Util.vbs: -------------------------------------------------------------------------------- 1 | ' 2 | ' @file Util.vbs 3 | ' @author Geoffrey Hunter (www.mbedded.ninja) 4 | ' @created 2014-11-11 5 | ' @last-modified 2016-05-09 6 | ' @brief General utility functions used across many of the modules. 7 | ' @details 8 | ' See README.rst in repo root dir for more info. 9 | 10 | ' Forces us to explicitly define all variables before using them 11 | Option Explicit 12 | 13 | Dim pi 14 | pi = 4 * Atn(1) 15 | 16 | ' @brief Function tests whether the input argument is an integer. 17 | ' @returns True if VarToTest is an integer, otherwise False. 18 | Function IsInt(VarToTest) 19 | If IsNumeric(VarToTest) Then 20 | ' Here, it still could be an integer or a floating point number 21 | ' The conversion to string is important 22 | If CStr(CLng(VarToTest)) = VarToTest Then 23 | ' Number is an integer 24 | IsInt = True 25 | Exit Function 26 | Else 27 | ' Number is not an integer 28 | IsInt = False 29 | Exit Function 30 | End If 31 | Else 32 | ' Number is not an integer 33 | IsInt = False 34 | Exit Function 35 | End If 36 | End Function 37 | 38 | ' @brief Function tests whether the input argument is "perfectly" numeric. 39 | ' @details This is a stricter test than the built-in IsNumeric. This test will return false 40 | ' for strings such as "2-", while IsNumeric will return true. UPDATE 2016-05-09: This 41 | ' is not really true anymore, as bug was found with current implementation. 42 | Function IsPerfectlyNumeric(VarToTest) 43 | 44 | 45 | ' First make sure variable is not an empty string 46 | If VarToTest = "" Then 47 | IsPerfectlyNumeric = False 48 | Exit Function 49 | End If 50 | 51 | ' Is numeric will return true if a valid number is at the 52 | ' start of the string, but doesn't detect invalid characters 53 | ' after the number (e.g. IsNumeric("2-") would return true). 54 | VarToTest = LocalizeNumberStr(VarToTest) 55 | 56 | If Not IsNumeric(VarToTest) Then 57 | IsPerfectlyNumeric = False 58 | Exit Function 59 | End If 60 | 61 | ' This makes sure that things like "2-" still get detected. 62 | ' Convert variable to double, then back to string. If it's equal 63 | ' to the original variable, then it is a valid number. 64 | ' UPDATE 2016-05-09: This code below caused valid numbers like "1.0" 65 | ' to fail, presumably because "1.0" was rounded to "1" 66 | 'If CStr(CDbl(VarToTest)) = VarToTest Then 67 | ' IsPerfectlyNumeric = True 68 | ' Exit Function 69 | ' Else 70 | ' IsPerfectlyNumeric = False 71 | ' Exit Function 72 | 'End If 73 | 74 | IsPerfectlyNumeric = True 75 | 76 | End Function 77 | 78 | ' @brief Determines whether a layer is an internal or external layer. 79 | ' @returns True if layer is an internal layer, otherwise False (external layer). 80 | Function IsInternalLayer(LayerId) 81 | If Not LayerId = 1 Then 82 | If Not LayerId = 32 Then 83 | IsInternalLayer = True 84 | Else 85 | IsInternalLayer = False 86 | End If 87 | Else 88 | IsInternalLayer = False 89 | End If 90 | End Function 91 | 92 | Function LPad(strInput, length, character) 93 | LPad = Right(String(length, character) & strInput, length) 94 | End Function 95 | 96 | Function RPad(strInput, length, character) 97 | RPad = Left(strInput & String(length, character), length) 98 | End Function 99 | 100 | ' @brief Returns input number rounded to specified number of significant figures. 101 | ' @param dblInput The input number. 102 | ' @param intSF The number of significant figures you want the number rounded to. 103 | ' @returns The rounded number. 104 | Function SfFormat(dblInput, intSF) 105 | 106 | Dim intCorrPower 'Exponent used in rounding calculation 107 | Dim intSign 'Holds sign of dblInput since logs are used in calculations 108 | 109 | ' Catch edge-case when input number is 0 110 | If dblInput = 0 Then 111 | SfFormat = 0 112 | Exit Function 113 | End If 114 | 115 | ' Store sign of dblInput 116 | intSign = Sgn(dblInput) 117 | 118 | ' Calculate exponent of dblInput 119 | intCorrPower = Int(Log10(Abs(dblInput))) 120 | 121 | SfFormat = Round(dblInput * 10 ^ ((intSF - 1) - intCorrPower)) 'integer value with no sig fig 122 | SfFormat = SfFormat * 10 ^ (intCorrPower - (intSF - 1)) 'raise to original power 123 | 124 | 125 | ' Reconsitute final answer 126 | SfFormat = SfFormat * intSign 127 | 128 | ' Answer sometimes needs padding with one or more 0's 129 | If InStr(SfFormat, ".") = 0 Then 130 | If Len(SfFormat) < intSF Then 131 | SfFormat = Format(SfFormat, "##0." & String(intSF - Len(SfFormat), "0")) 132 | End If 133 | End If 134 | 135 | If intSF > 1 And Abs(SfFormat) < 1 Then 136 | Do Until Left(Right(SfFormat, intSF), 1) <> "0" And Left(Right(SfFormat, intSF), 1) <> "." 137 | SfFormat = SfFormat & "0" 138 | Loop 139 | End If 140 | 141 | End Function 142 | 143 | ' @brief Returns the user's home folder. 144 | ' @details Used by the UserData.vbs module. 145 | ' @returns The user's home folder as a absolute path string. 146 | Function GetUsersHomeFolder(dummyVar) 147 | 148 | ' Get the user's home folder 149 | Dim oShell 150 | Set oShell = CreateObject("WScript.Shell") 151 | Dim homeFolder 152 | homeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%") 153 | 154 | ' Return the user's home folder as a string 155 | GetUsersHomeFolder = homeFolder 156 | End Function 157 | 158 | ' @brief Gets the height of either a via or hole object. 159 | ' @details Correctly calculates the actual height of any via or hole (even blind or buried) by using it's start and stop layers 160 | ' and iterating through the layer stack, adding up the thicknesses of everything in between. 161 | ' @note Will return a height slightly less that the total height of the PCB for vias that go from the top 162 | ' layer to the bottom layer, as it does not include the soldermask of silkscreen thickness. 163 | Function GetViaOrHoleHeightMm(board, viaOrHole) 164 | 165 | 166 | Dim layerIterator 167 | layerIterator = board.ElectricalLayerIterator 168 | 169 | Dim startLayerFound, stopLayerFound 170 | Dim heightSumTCoord 171 | heightSumTCoord = 0 172 | 173 | Do While layerIterator.Next 174 | 'ShowMessage("Layer name = '" + layerIterator.LayerObject.Name + "', layerID = '" + CStr(layerIterator.LayerObject.LayerID) + "', copper height = '" + CStr(layerIterator.LayerObject.CopperThickness) + "', di-electric Height = '" + CStr(CoordToMMs(layerIterator.LayerObject.Dielectric.DielectricHeight)) + "'.") 175 | 176 | 'ShowMessage("Via/hole.ObjectID = " + CStr(viaOrHole.ObjectID) + "'.") 177 | If viaOrHole.ObjectID = eViaObject Then 178 | If viaOrHole.StartLayer.LayerID = layerIterator.LayerObject.LayerID Then 179 | 'ShowMessage("Via/hole start layer = '" + layerIterator.LayerObject.Name + "'.") 180 | startLayerFound = true 181 | End If 182 | ElseIf viaOrHole.ObjectID = ePadObject Then 183 | startLayerFound = true 184 | End If 185 | 186 | If viaOrHole.ObjectID = eViaObject Then 187 | If viaOrHole.StopLayer.LayerID = layerIterator.LayerObject.LayerID Then 188 | 'ShowMessage("Via/hole stop layer = '" + layerIterator.LayerObject.Name + "'.") 189 | stopLayerFound = true 190 | End If 191 | End If 192 | 193 | If startLayerFound = true And stopLayerFound = false Then 194 | ' We are on OR past the layer that the via starts on, AND we are not on the layer that the via stops on. 195 | heightSumTCoord = heightSumTCoord + layerIterator.LayerObject.CopperThickness + layerIterator.LayerObject.Dielectric.DielectricHeight 196 | End If 197 | 198 | If stopLayerFound = true Then 199 | ' We are on the layer that the via stops at! 200 | heightSumTCoord = heightSumTCoord + layerIterator.LayerObject.CopperThickness 201 | GetViaOrHoleHeightMm = CoordToMMs(heightSumTCoord) 202 | 'ShowMessage("Via/hole height = '" + CStr(CoordToMMs(heightSumTCoord)) + "mm'.") 203 | Exit Function 204 | End If 205 | 206 | Loop 207 | 208 | ' We will only get here if it is a pad! 209 | GetViaOrHoleHeightMm = CoordToMMs(heightSumTCoord) 210 | 211 | End Function 212 | 213 | 214 | ' @brief Localizes fractional separator in strings, which contains numbers 215 | ' 216 | Function LocalizeNumberStr(str) 217 | 218 | ' check locale 219 | if( CStr(0.1) = "0,1" ) then 220 | LocalizeNumberStr = Replace(str,".",",") 221 | else 222 | LocalizeNumberStr = Replace(str,",",".") 223 | end if 224 | 225 | End Function 226 | --------------------------------------------------------------------------------