├── .gitignore ├── LICENSE ├── OutJob ├── OutJob-Script │ ├── OJExample.PrjScr │ ├── SimpleOJScript.dfm │ └── SimpleOJScript.pas └── SavePCB_ASCII.pas ├── PCB ├── ClassConnections │ ├── ClassConnForm.dfm │ ├── ClassConnForm.pas │ ├── ShowClassConnections.PrjScr │ └── ShowClassConnections.pas ├── CleanNets │ └── CleanRBConnections.pas ├── CompParameters.pas ├── CopySUIDToClipBoard │ ├── RunScript-UUID.txt │ └── SUIDToClipboard.pas ├── DisperseComps.pas ├── EmbedLayerColours.pas ├── EmbeddedBoardPnPX.pas ├── LayerHacks │ └── LayerHacking2.pas ├── LayerStackReport-test.pas ├── LocationJump.pas ├── MechLayerNames.pas ├── NetViaAntennasDRC.pas ├── PCBFilter.pas ├── PadShapeRemoved.pas ├── ParallelPanPCB │ ├── PanPCB.PrjScr │ ├── PanPCB.pas │ ├── PanPCBForm.dfm │ └── PanPCBForm.pas ├── PlanePolyTools.pas ├── PolygonAreas2.pas ├── PolygonReFitBO.pas ├── README.md ├── ReUnion.pas ├── RedrawPlaneOutlines.pas ├── RefPlaneRegion-fn-MakeRegionFromPoly.pas ├── RemovedPadDRC.pas ├── SelectCMPInOutSideBOL.pas ├── SimpleRegion.pas ├── StarvedPadViaDRC.pas ├── ToggleSolderMasks02.pas └── ToogleModels.pas ├── PcbLib ├── DeleteSelectedItemsInPcbLib.pas ├── FootPrintText_2.pas ├── LibraryCompFPsWithSelectedPrimitives.pas ├── MakeRegionShapes │ ├── MakeRegionShapes.pas │ ├── Screenshot from 2022-10-14 10-04-39.png │ └── Screenshot from 2022-10-15 08-50-52.png ├── MechLayerMapping │ ├── MechLayerMapping.pas │ └── PCBLibrariesDefault01.ini ├── OutlineRegionsOnLayer.pas ├── ReportComp3DModels.pas ├── SplitFootprintMechLayers.pas └── Split_CombinePcbLib.pas ├── Project ├── OutJob │ ├── RunOutJobDocs.pas │ └── dummy.txt ├── Prj-Parameters.pas ├── PrjLibReLinker │ ├── CompSourceLibReLinker.pas │ ├── PrjLibReLinker.PrjScr │ ├── PrjLibReLinker.pas │ └── Readme.txt └── UpdateSheetSymbolFN.pas ├── README.md ├── Sch ├── CompPlaceFromLib.pas ├── CompVaultState.pas ├── ExtractTemplate.pas ├── NoNetWires.pas ├── RemoveSheetParameter.pas └── TogglePinVis.pas ├── SchLib ├── CompRename2.pas ├── CountSymbolPins.pas ├── PinFunctions │ ├── Pinfunctions.txt │ ├── SymbolPinFunctions.pas │ └── SymbolPinFunctions.txt ├── RemoveLibAndModelFileLinks.pas └── Split_CombineSchLib.pas ├── System ├── AltiumLivePortalRegSettings.pas ├── CoordError.pas ├── CustomColours.pas ├── DialogClose │ ├── DialogClose.pas │ ├── FocusAltium.vbs │ └── StartAndReturn.bat ├── InstallSummary.pas ├── InternalOptions.pas ├── ListLibraries2.pas ├── PCBLayerOrder.pas ├── ReleaserSettings.pas ├── Zipper-example.pas └── dummy.txt └── common └── libADOQuery (clean).pas /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | -------------------------------------------------------------------------------- /OutJob/OutJob-Script/SimpleOJScript.dfm: -------------------------------------------------------------------------------- 1 | object FormPickFromList: TFormPickFromList 2 | Left = 500 3 | Top = 600 4 | Align = alCustom 5 | BorderIcons = [biSystemMenu] 6 | BorderStyle = bsDialog 7 | BorderWidth = 2 8 | Caption = 'Pick Option' 9 | ClientHeight = 213 10 | ClientWidth = 299 11 | Color = clBtnFace 12 | Constraints.MaxHeight = 250 13 | Constraints.MaxWidth = 350 14 | Font.Charset = DEFAULT_CHARSET 15 | Font.Color = clWindowText 16 | Font.Height = -11 17 | Font.Name = 'Tahoma' 18 | Font.Style = [] 19 | FormStyle = fsStayOnTop 20 | OldCreateOrder = False 21 | Position = poDefaultSizeOnly 22 | OnCreate = FormPickFromListCreate 23 | PixelsPerInch = 96 24 | TextHeight = 13 25 | object ComboBoxFiles: TComboBox 26 | Left = 40 27 | Top = 24 28 | Width = 184 29 | Height = 21 30 | TabOrder = 0 31 | Text = 'Pick a listed item' 32 | end 33 | object ButtonExit: TButton 34 | Left = 56 35 | Top = 160 36 | Width = 104 37 | Height = 24 38 | Caption = 'Done' 39 | TabOrder = 1 40 | OnClick = ButtonExitClick 41 | end 42 | end 43 | -------------------------------------------------------------------------------- /OutJob/SavePCB_ASCII.pas: -------------------------------------------------------------------------------- 1 | { SavePCB_ASCII.pas 2 | 3 | setup to export Protel 2.8. but can export Altium ascii 4 | Author BL Miller 5 | 6 | 2023-07-22 v0.1 POC copied from existing OJ & PCB export scripts. 7 | 2023-07-25 v1.0 workaround annoying duplicate parameters. 8 | 9 | Would be nice to use GetState_Parameter & TParameterList methods but these do not allow getting at the duplicates! 10 | 11 | AD17: 12 | Something is not right about Parameter string passed to Generate(). 13 | Can have multiple TargetFilename etc, do some have leading space? 14 | After Outjob save close reopen, duplicates are gone ? 15 | Parameter is Not properly maintained as ParameterList inside Altium. 16 | Can NOT pass back all Parameters from Configure() as end up with duplicates (with empty value or space ' ' ! 17 | But need to pass back TargetFileName. 18 | 19 | TBD: 20 | add Messages panel support to indicate pass fail. 21 | switch ascii export formats in Configure() ? 22 | 23 | Server process: 24 | Process: PCB:Export 25 | Parameters: Format = HyperLynx | FileName = PCBBoard.PCBDoc 26 | This automatically exports a file called PCBBoard.PCBDoc to the current directory in HyperLynx format. 27 | PROTEL NETLIST, SPECCTRA DESIGN, 28 | DXF, HYPERLINX, IPC, NETLIST, SHAPE, 29 | SELECTED 30 | 31 | both these work (save) in script. 32 | NewServerDoc.DoFileSave('PCB ASCII File(*.PcbDoc)'); 33 | NewServerDoc.DoFileSave('Protel PCB 2.8 ASCII(*.pcb)'); 34 | 35 | from Altium SDK info 36 | Schematic Template, Binary and a blank string "" represent the same Altium Designer file format. 37 | 'ASCII' – ASCII format 38 | 'ORCAD' – ORCAD format 39 | 'TEMPLATE' 40 | 'BINARY' – standard binary format 41 | 'AUTOCAD DXF' – DXF format 42 | 'AUTOCAD DWG' – DWG format} 43 | } 44 | 45 | const 46 | cSourceFileNameParameter = 'SourceFileName'; 47 | cSourceFolderParameter = 'SourceFolder'; 48 | cDefaultOutputFN = 'Default.Pcb'; 49 | cDebug = false; // true; 50 | var 51 | Prj : IProject; 52 | ParamList : TSStringList; // TParameterList; 53 | Report : TStringList; 54 | OutputFN : WideString; 55 | SourceFolder : WideString; 56 | TargetPCB : WideString; 57 | TargetFolder : WideString; 58 | TargetPrefix : WideString; 59 | AddToProject : boolean; 60 | 61 | function GetParameterStr(Parameter : WideString) : WideString; forward; 62 | function SetParameterStr(Parameter : WideString) : WideString; forward; 63 | function PredictOutputFileNames(Parameter : String) : WideString; forward; 64 | function GetStringListNameValue(const SL : TStringList, const Name : WideString) : TStringList; forward; 65 | function MakeReport (const FN: WideString, const Parameter : Widestring); forward; 66 | 67 | // Parameter == TargetFolder= TargetFileName= TargetPrefix= OpenOutputs=(boolean) AddToProject=(boolean) 68 | 69 | procedure Generate(Parameter : String); 70 | var 71 | NewServerDoc : IServerDocument; 72 | OutputFullPath : WideString; 73 | Success : integer; // long bool 74 | begin 75 | if cDebug then MakeReport('generate.txt', Parameter); 76 | 77 | OutputFN := TargetFolder + PredictOutputFileNames(Parameter); 78 | OutputFullPath := TargetFolder + OutputFN; 79 | 80 | if PCBServer = nil then Client.StartServer('PCB'); 81 | 82 | if not FileExists(SourceFolder + TargetPCB, false) then 83 | begin 84 | ShowMessage(TargetPCB + ' file does not exist'); 85 | exit; 86 | end; 87 | if ((SourceFolder + TargetPCB) = OutputFullPath) then exit; 88 | 89 | // avoid goofy Altium methods that are dangerous unreliable. 90 | CopyFile(SourceFolder + TargetPCB, OutputFullPath, false); 91 | NewServerDoc := Client.OpenDocument('PCB', OutputFullPath); 92 | NewServerDoc.Filename; 93 | 94 | // both these work (save) 95 | // Success := NewServerDoc.DoFileSave('PCB ASCII File(*.PcbDoc)'); // Altium Ascii 96 | // save as Protel Ascii 97 | Success := NewServerDoc.DoFileSave('Protel PCB 2.8 ASCII(*.pcb)'); // PCB FILE 6 VERSION 2.80 98 | 99 | if Success = -1 then 100 | if AddToProject then 101 | Prj.DM_AddSourceDocument(NewServerDoc.Filename); 102 | end; 103 | 104 | function Configure(Parameter : String) : WideString; 105 | Var 106 | Path : String; 107 | begin 108 | if cDebug then MakeReport('configure.txt', Parameter); 109 | 110 | GetParameterStr(Parameter); 111 | Path := SourceFolder; 112 | 113 | ResetParameters; 114 | AddStringParameter('Dialog', 'FileOpenSave'); 115 | AddStringParameter('Mode', '0'); 116 | AddStringParameter('FileType1', 'PCB File (*.PcbDoc)|*.PcbDoc'); 117 | AddStringParameter('Prompt', 'Select a PcbDoc then click OK'); 118 | AddStringParameter('Path', Path); 119 | RunProcess('Client:RunCommonDialog'); 120 | 121 | GetStringParameter('Result', Path); 122 | if Path = 'True' then 123 | begin 124 | GetStringParameter('File1', Path); 125 | GetStringParameter('Path', Path); 126 | SourceFolder := ExtractFilePath(Path); 127 | TargetPCB := ExtractFileName(Path); 128 | end; 129 | 130 | OutputFN := StringReplace(TargetPCB, 'PcbDoc', 'Pcb',1); 131 | 132 | Result := cSourceFileNameParameter + '=' + TargetPCB; 133 | Result := Result + '|' + cSourceFolderParameter + '=' + SourceFolder; 134 | // Result := Result + '|' + 'TargetFileName' + '=' + OutputFN; 135 | 136 | // expt extra spaces in name to influence duplicates. 137 | // Result := Result + '|' + ' TargetFileName' + '=' + OutputFN; 138 | // Result := Result + '|' + 'TargetFileName ' + '=' + OutputFN; 139 | end; 140 | 141 | // OutJob Output Container "Change" 142 | function PredictOutputFileNames(Parameter : String) : WideString; 143 | // return is just a string of filenames delimited by '|' 144 | begin 145 | if cDebug then MakeReport('predict.txt', Parameter); 146 | 147 | GetParameterStr(Parameter); 148 | OutputFN := StringReplace(TargetPCB, 'PcbDoc', 'Pcb',1); 149 | Result := OutputFN; 150 | end; 151 | 152 | // parse for key parameters & set vars in this scope. 153 | function GetParameterStr(const Parameter : WideString) : WideString; 154 | var 155 | Doc : IDocument; 156 | sVal : WideString; 157 | MatchList : TStringList; 158 | I : integer; 159 | begin 160 | MatchList := TStringList.Create; 161 | ParamList := TStringList.Create; 162 | ParamList.Delimiter := '|'; 163 | ParamList.NameValueSeparator := '='; 164 | ParamList.StrictDelimiter := true; 165 | ParamList.DelimitedText := Parameter; 166 | 167 | Prj := GetWorkspace.DM_FocusedProject; 168 | Doc := Prj.DM_PrimaryImplementationDocument; 169 | TargetPCB := ExtractFilename(Doc.DM_FileName); 170 | SourceFolder := ExtractFilePath(Prj.DM_ProjectFullPath); 171 | OutputFN := StringReplace(TargetPCB, 'PcbDoc', 'Pcb',1); 172 | 173 | // source PCB 174 | if GetState_Parameter(Parameter, cSourceFileNameParameter, sVal) then 175 | TargetPCB := Trim(sVal); 176 | if GetState_Parameter(Parameter, cSourceFolderParameter, sVal) then 177 | SourceFolder := Trim(sVal); 178 | 179 | // output target file 180 | // deal to multiples with blank values! 181 | MatchList := GetStringListNameValue(ParamList, 'TargetFileName'); 182 | for I := 0 to (MatchList.Count - 1) do 183 | begin 184 | sVal := Trim(MatchList.Strings(I)); 185 | if sVal <> '' then 186 | begin 187 | OutputFN := sVal; 188 | break; 189 | end; 190 | end; 191 | 192 | if GetState_Parameter(Parameter, 'TargetPrefix', sVal) then 193 | TargetPrefix := Trim(sVal); 194 | 195 | MatchList := GetStringListNameValue(ParamList, 'TargetFolder'); 196 | for I := 0 to (MatchList.Count - 1) do 197 | begin 198 | sVal := Trim(MatchList.Strings(I)); 199 | if sVal <> '' then 200 | begin 201 | TargetFolder := sVal; 202 | break; 203 | end; 204 | end; 205 | 206 | AddToProject := false; 207 | if GetState_Parameter(Parameter, 'AddToProject', sVal) then 208 | AddToProject := (Trim(sVal) = 'True'); 209 | 210 | MatchList.Free; 211 | ParamList.Free; 212 | end; 213 | 214 | // direct call method for testing 215 | procedure main(hideme : integer); 216 | var 217 | Doc : IDocument; 218 | begin 219 | Prj := GetWorkspace.DM_FocusedProject; 220 | Doc := Prj.DM_PrimaryImplementationDocument; 221 | TargetPCB := ExtractFilename(Doc.DM_FileName); 222 | SourceFolder := ExtractFilePath(Prj.DM_ProjectFullPath); 223 | TargetFolder := SourceFolder + 'Script\'; 224 | Generate(cSourceFolderParameter + '=' + SourceFolder + '|' +cSourceFileNameParameter + '=' + TargetPCB + 225 | '|TargetFolder=' + TargetFolder + '|TargetFileName=' + cDefaultOutputFN + '| OpenOutputs=false'); 226 | end; 227 | 228 | function MakeReport (const FN: WideString, const Parameter : Widestring); 229 | begin 230 | Report := TStringList.Create; 231 | Report.Delimiter := '|'; 232 | // Report.NameValueSeparator := '='; 233 | Report.StrictDelimiter := true; 234 | Report.DelimitedText := Parameter; 235 | Report.SaveToFile('c:\temp\' + FN); 236 | Report.Free; 237 | end; 238 | 239 | function GetStringListNameValue(const SL : TStringList, const Name : WideString) : TStringList; 240 | var 241 | sVal : WideString; 242 | I : integer; 243 | begin 244 | Result := TStringList.Create; 245 | for I := 0 to (SL.Count - 1) do 246 | begin 247 | if ParamList.Names(I) = Name then 248 | begin 249 | sVal := ParamList.ValuefromIndex(I); 250 | Result.Add(sVal); 251 | end; 252 | end; 253 | end; 254 | 255 | // WIP 256 | Function GetOutputFileNameWithExtension(Ext : String) : String; 257 | Begin 258 | Prj := GetWorkspace.DM_FocusedProject; 259 | If TargetFolder = '' Then 260 | TargetFolder := Prj.DM_GetOutputPath; 261 | If TargetFileName = '' Then 262 | TargetFN := Prj.DM_ProjectFileName; 263 | Result := AddSlash(TargetFolder) + TargetPrefix + ChangeFileExt(TargetFN, Ext); 264 | End; 265 | 266 | 267 | -------------------------------------------------------------------------------- /PCB/ClassConnections/ClassConnForm.dfm: -------------------------------------------------------------------------------- 1 | object CCForm: TCCForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Class Connections' 5 | ClientHeight = 160 6 | ClientWidth = 308 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 | OnClose = FormClose 15 | OnCreate = FormCreate 16 | OnMouseEnter = CCFormMouseEnter 17 | OnShow = FormShow 18 | PixelsPerInch = 96 19 | TextHeight = 13 20 | object ComboBox1: TComboBox 21 | Left = 23 22 | Top = 17 23 | Width = 184 24 | Height = 21 25 | TabOrder = 0 26 | Text = 'cb1-NetClasses' 27 | end 28 | object butShow: TButton 29 | Left = 20 30 | Top = 90 31 | Width = 60 32 | Height = 25 33 | Caption = 'Show' 34 | TabOrder = 1 35 | OnClick = butShowClick 36 | end 37 | object butHide: TButton 38 | Left = 95 39 | Top = 90 40 | Width = 60 41 | Height = 25 42 | Caption = 'Hide' 43 | TabOrder = 2 44 | OnClick = butHideClick 45 | end 46 | object ComboBox2: TComboBox 47 | Left = 23 48 | Top = 49 49 | Width = 184 50 | Height = 21 51 | TabOrder = 3 52 | Text = 'cb1-CMPClasses' 53 | end 54 | object butLogic: TButton 55 | Left = 228 56 | Top = 13 57 | Width = 60 58 | Height = 25 59 | Caption = 'AND/OR' 60 | Style = bsSplitButton 61 | TabOrder = 4 62 | OnClick = butLogicClick 63 | end 64 | object butShowAll: TButton 65 | Left = 20 66 | Top = 125 67 | Width = 60 68 | Height = 25 69 | Caption = 'Show All' 70 | TabOrder = 5 71 | OnClick = butShowAllClick 72 | end 73 | object butHideAll: TButton 74 | Left = 95 75 | Top = 125 76 | Width = 60 77 | Height = 25 78 | Caption = 'Hide All' 79 | TabOrder = 6 80 | OnClick = butHideAllClick 81 | end 82 | object butColour: TButton 83 | Left = 248 84 | Top = 90 85 | Width = 45 86 | Height = 25 87 | Caption = 'Colour' 88 | TabOrder = 7 89 | OnClick = butColourClick 90 | end 91 | object butDefColour: TButton 92 | Left = 248 93 | Top = 125 94 | Width = 45 95 | Height = 25 96 | Caption = 'Default' 97 | TabOrder = 8 98 | OnClick = butDefColourClick 99 | end 100 | object butHighlight: TButton 101 | Left = 170 102 | Top = 90 103 | Width = 60 104 | Height = 25 105 | Caption = 'Hi-Lite' 106 | TabOrder = 9 107 | OnClick = butHighlightClick 108 | end 109 | object ColorDialog1: TColorDialog 110 | Left = 264 111 | Top = 52 112 | end 113 | end 114 | -------------------------------------------------------------------------------- /PCB/ClassConnections/ClassConnForm.pas: -------------------------------------------------------------------------------- 1 | { ShowClassConnections.pas / ClassConnForm.pas 2 | Form & event code ONLY. 3 | } 4 | 5 | Interface // this is ignored in delphiscript. 6 | type 7 | TCCForm = class(TForm) 8 | ComboBox1 : TComboBox; 9 | ComboBox2 : TComboBox; 10 | butLogic : TButton; 11 | butShow : TButton; 12 | butHide : TButton; 13 | butShowAll : TButton; 14 | butHideAll : TButton; 15 | butHighlight : TButton; 16 | butColour : TButton; 17 | butDefColour : TButton; 18 | ColorDialog1 : TColorDialog; 19 | end; 20 | 21 | procedure FormReloadDialogs(dummy : integer); forward; 22 | 23 | function TCCForm.ShowForm(dummy : integer) : boolean; 24 | begin 25 | CCForm.FormStyle := fsStayOnTop; 26 | CCForm.Show; 27 | end; 28 | 29 | function TCCForm.FormCreate(Sender: TObject); 30 | begin 31 | CCForm.Caption := CCForm .Caption + '_V0.23'; 32 | CCForm.butLogic.Caption := SetOperation(false); 33 | CCForm.ColorDialog1.Color := clRed; 34 | End; 35 | 36 | function TCCForm.FormShow(Sender: TObject); 37 | begin 38 | RefreshBoard(1); 39 | FormReloadDialogs(1); 40 | 41 | CCForm.ComboBox1.Text := CCForm.ComboBox1.Items(0); 42 | CCForm.ComboBox2.Text := CCForm.ComboBox2.Items(0); 43 | End; 44 | 45 | procedure TCCForm.CCFormMouseEnter(Sender: TObject); 46 | begin 47 | // DNW well with AD23 screws up form dialog. 48 | // RefreshBoard(1); 49 | // FormReloadDialogs(1); 50 | end; 51 | 52 | procedure FormReloadDialogs(dummy : integer); 53 | var 54 | NetClass : IPCB_ObjectClass; 55 | I : integer; 56 | ItemIndex : integer; 57 | begin 58 | // could check if existing .Text exists in new "collection" & reset it ? 59 | // check/fix the index 60 | ItemIndex := ComboBox1.ItemIndex; 61 | if not (ItemIndex < NetClasses.Count) then 62 | begin 63 | ComboBox1.ItemIndex := 0; 64 | NetClass := NetClasses.Items(0); 65 | CCForm.ComboBox1.Text := NetClass.Name; 66 | end; 67 | // trim the top 68 | while (CCForm.ComboBox1.Items.Count > NetClasses.Count) do 69 | CCForm.ComboBox1.Items.Delete(CCForm.ComboBox1.Items.Count - 1); 70 | // refresh & add 71 | for I := 0 to (NetClasses.Count - 1) do 72 | begin 73 | NetClass := NetClasses.Items(I); 74 | if I < CCForm.ComboBox1.Items.Count then 75 | CCForm.ComboBox1.Items(I) := NetClass.Name 76 | else 77 | CCForm.ComboBox1.Items.Add(NetClass.Name); 78 | end; 79 | if CCForm.ComboBox1.Items.Count = 0 then 80 | CCForm.ComboBox1.Text := 'no Net Classes'; 81 | 82 | ItemIndex := ComboBox2.ItemIndex; 83 | if not (ItemIndex < CMPClasses.Count) then 84 | begin 85 | ComboBox2.ItemIndex := 0; 86 | NetClass := CMPClasses.Items(0); 87 | CCForm.ComboBox2.Text := NetClass.Name; 88 | end; 89 | 90 | while (CCForm.ComboBox2.Items.Count > CMPClasses.Count) do 91 | CCForm.ComboBox2.Items.Delete(CCForm.ComboBox2.Items.Count - 1); 92 | 93 | for I := 0 to (CMPClasses.Count - 1) do 94 | begin 95 | NetClass := CMPClasses.Items(I); 96 | if I < CCForm.ComboBox2.Items.Count then 97 | CCForm.ComboBox2.Items(I) := NetClass.Name 98 | else 99 | CCForm.ComboBox2.Items.Add(NetClass.Name); 100 | end; 101 | if CCForm.ComboBox2.Items.Count = 0 then 102 | CCForm.ComboBox2.Text := 'no CMP classes'; 103 | 104 | NetClass := nil; 105 | end; 106 | 107 | procedure TCCForm.butShowClick(Sender); // Show Connections 108 | begin 109 | ActionRatNests(ComboBox1.Text, ComboBox2.Text, cShow); 110 | End; 111 | 112 | procedure TCCForm.butHideClick(Sender); // Hide Connections 113 | begin 114 | ActionRatNests(ComboBox1.Text, ComboBox2.Text, cHide); 115 | End; 116 | 117 | procedure TCCForm.FormClose(Sender: TObject; var Action: TCloseAction); 118 | begin 119 | CCForm.ComboBox1.Free; 120 | CCForm.ComboBox2.Free; 121 | CCForm.ColorDialog1.Free; 122 | CleanExit(1); 123 | end; 124 | 125 | procedure TCCForm.butLogicClick(Sender: TObject); 126 | begin 127 | CCForm.butLogic.Caption := SetOperation(true); 128 | end; 129 | 130 | procedure TCCForm.butShowAllClick(Sender: TObject); 131 | begin 132 | ActionRatNests(cAllNetsClass, cAllCMPsClass, cShow); 133 | end; 134 | 135 | procedure TCCForm.butHideAllClick(Sender: TObject); 136 | begin 137 | ActionRatNests(cAllNetsClass, cAllCMPsClass, cHide); 138 | end; 139 | 140 | procedure TCCForm.butHighlightClick(Sender: TObject); 141 | begin 142 | ActionRatNests(ComboBox1.Text, ComboBox2.Text, cHigh); 143 | end; 144 | 145 | procedure TCCForm.butColourClick(Sender: TObject); 146 | var 147 | Colour : TColor; 148 | begin 149 | if CCForm.ColorDialog1.Execute then 150 | begin 151 | Colour := CCForm.ColorDialog1.Color; 152 | ActionColour(ComboBox1.Text, ComboBox2.Text, Colour, 1); 153 | end; 154 | end; 155 | 156 | procedure TCCForm.butDefColourClick(Sender: TObject); 157 | var 158 | Colour : TColor; 159 | begin 160 | Colour := cDefaultColour; 161 | ActionColour(ComboBox1.Text, ComboBox2.Text, Colour, 1); 162 | end; 163 | 164 | 165 | -------------------------------------------------------------------------------- /PCB/ClassConnections/ShowClassConnections.PrjScr: -------------------------------------------------------------------------------- 1 | [Design] 2 | Version=1.0 3 | HierarchyMode=0 4 | ChannelRoomNamingStyle=0 5 | ReleasesFolder= 6 | ChannelDesignatorFormatString=$Component_$RoomName 7 | ChannelRoomLevelSeperator=_ 8 | OpenOutputs=1 9 | ArchiveProject=0 10 | TimestampOutput=0 11 | SeparateFolders=0 12 | TemplateLocationPath= 13 | PinSwapBy_Netlabel=1 14 | PinSwapBy_Pin=1 15 | AllowPortNetNames=0 16 | AllowSheetEntryNetNames=1 17 | AppendSheetNumberToLocalNets=0 18 | NetlistSinglePinNets=0 19 | DefaultConfiguration=Default - All Constraints 20 | UserID=0xFFFFFFFF 21 | DefaultPcbProtel=1 22 | DefaultPcbPcad=0 23 | ReorderDocumentsOnCompile=1 24 | NameNetsHierarchically=0 25 | PowerPortNamesTakePriority=0 26 | PushECOToAnnotationFile=1 27 | DItemRevisionGUID= 28 | ReportSuppressedErrorsInMessages=0 29 | FSMCodingStyle=eFMSDropDownList_OneProcess 30 | FSMEncodingStyle=eFMSDropDownList_OneHot 31 | OutputPath= 32 | LogFolderPath= 33 | ManagedProjectGUID= 34 | LinkedManagedProjectGUID= 35 | IncludeDesignInRelease=0 36 | 37 | [Preferences] 38 | PrefsVaultGUID= 39 | PrefsRevisionGUID= 40 | 41 | [Document1] 42 | DocumentPath=ShowClassConnections.pas 43 | AnnotationEnabled=1 44 | AnnotateStartValue=1 45 | AnnotationIndexControlEnabled=0 46 | AnnotateSuffix= 47 | AnnotateScope=All 48 | AnnotateOrder=-1 49 | DoLibraryUpdate=1 50 | DoDatabaseUpdate=1 51 | ClassGenCCAutoEnabled=1 52 | ClassGenCCAutoRoomEnabled=1 53 | ClassGenNCAutoScope=None 54 | DItemRevisionGUID= 55 | GenerateClassCluster=0 56 | DocumentUniqueId= 57 | 58 | [Document2] 59 | DocumentPath=ClassConnForm.pas 60 | AnnotationEnabled=1 61 | AnnotateStartValue=1 62 | AnnotationIndexControlEnabled=0 63 | AnnotateSuffix= 64 | AnnotateScope=All 65 | AnnotateOrder=-1 66 | DoLibraryUpdate=1 67 | DoDatabaseUpdate=1 68 | ClassGenCCAutoEnabled=1 69 | ClassGenCCAutoRoomEnabled=1 70 | ClassGenNCAutoScope=None 71 | DItemRevisionGUID= 72 | GenerateClassCluster=0 73 | DocumentUniqueId= 74 | 75 | [Document3] 76 | DocumentPath=ClassConnForm.dfm 77 | AnnotationEnabled=1 78 | AnnotateStartValue=1 79 | AnnotationIndexControlEnabled=0 80 | AnnotateSuffix= 81 | AnnotateScope=All 82 | AnnotateOrder=-1 83 | DoLibraryUpdate=1 84 | DoDatabaseUpdate=1 85 | ClassGenCCAutoEnabled=1 86 | ClassGenCCAutoRoomEnabled=1 87 | ClassGenNCAutoScope=None 88 | DItemRevisionGUID= 89 | GenerateClassCluster=0 90 | DocumentUniqueId= 91 | 92 | [Parameter1] 93 | Name=Version 94 | Value=1.30 95 | 96 | [Parameter2] 97 | Name=Modified By 98 | Value=BL Miller 99 | 100 | [Parameter3] 101 | Name=Author Original 102 | Value=www.tdpcb.com 103 | 104 | [Generic_ScriptingSystem] 105 | StartProcName=> 106 | 107 | -------------------------------------------------------------------------------- /PCB/CompParameters.pas: -------------------------------------------------------------------------------- 1 | {.............................................................................. 2 | Summary 3 | PCB Doc focused component parameter dumper 4 | using DMObjects 5 | 6 | B. Miller 7 | 13/01/2020 v0.01 initial POC 8 | 14/01/2020 v0.11 cruft removal 9 | 02/05/2023 v0.12 support PcbDoc with no project 10 | 11 | ..............................................................................} 12 | 13 | Var 14 | WS : IWorkspace; 15 | Doc : IDocument; 16 | Prj : IBoardProject; 17 | Board : IPCB_Board; 18 | Param : IParameter; 19 | PrjReport : TStringList; 20 | PCBList : TStringList; 21 | FilePath : WideString; 22 | FileName : WideString; 23 | 24 | {..............................................................................} 25 | 26 | Procedure ReportCompParameters; 27 | var 28 | PCBComp : IPCB_Component; 29 | Iterator : IPCB_BoardIterator; 30 | ParamReport : TStringList; 31 | 32 | ReportDocument : IServerDocument; 33 | PrimDoc : IDocument; 34 | 35 | Comp : IComponent; 36 | I, J, K : Integer; 37 | 38 | Begin 39 | WS := GetWorkspace; 40 | If WS = Nil Then Exit; 41 | 42 | WS.DM_ProjectCount; 43 | 44 | Prj := WS.DM_FocusedProject; 45 | // If Prj = Nil Then Exit; 46 | // Prj.DM_Compile; 47 | 48 | // PrimDoc := Prj.DM_PrimaryImplementationDocument; 49 | Doc := WS.DM_FocusedDocument; 50 | If (Doc.DM_DocumentKind <> cDocKind_Pcb) Then exit; 51 | 52 | // required for the Board interface iterating eCompObject 53 | { 54 | If PCBServer = Nil then Client.StartServer('PCB'); 55 | Board := PCBServer.GetCurrentPCBBoard; 56 | If Board = Nil Then 57 | Board := PCBServer.GetPCBBoardByPath(Doc.DM_FullPath); 58 | If Board = Nil Then 59 | Board := PCBServer.LoadPCBBoardByPath(Doc.DM_FullPath); 60 | if Board = Nil then Exit; 61 | } 62 | 63 | BeginHourGlass(crHourGlass); 64 | 65 | PrjReport := TStringList.Create; 66 | 67 | PrjReport.Add('PcbDoc CMP Footprint Model information:'); 68 | if Prj <> Nil then 69 | begin 70 | PrjReport.Add(' Project: ' + Prj.DM_ProjectFileName); 71 | PrjReport.Add(''); 72 | end; 73 | 74 | PrjReport.Add(''); 75 | 76 | // For I := 0 to (Prj.DM_PhysicalDocumentCount - 1) Do 77 | // Begin 78 | // Doc := Prj.DM_PhysicalDocuments(I); 79 | 80 | If Doc.DM_DocumentKind = cDocKind_Pcb Then 81 | begin 82 | // without this the DM_ComponentCount = 0 !! 83 | Doc.DM_Compile; 84 | 85 | PrjReport.Add(''); 86 | PrjReport.Add(' Board : ' + Doc.DM_FileName); 87 | PrjReport.Add(''); 88 | 89 | for J := 0 to Doc.DM_ComponentCount - 1 Do 90 | begin 91 | Comp := Doc.DM_Components(J); 92 | 93 | PrjReport.Add(' Component LogDes : ' + Comp.DM_LogicalDesignator + ' | PhysDes: ' + Comp.DM_PhysicalDesignator + ' | CalcDes: ' + Comp.DM_CalculatedDesignator); 94 | PrjReport.Add(' Lib Reference : ' + Comp.DM_LibraryReference); 95 | PrjReport.Add(' Comp FootPrint : ' + Comp.DM_FootPrint); 96 | PrjReport.Add(' Current FP Model : ' + Comp.DM_CurrentImplementation(cDocKind_PcbLib).DM_ModelName + ' ModelType :' + Comp.DM_CurrentImplementation(cDocKind_PcbLib).DM_ModelType); 97 | 98 | 99 | // report component level parameters 100 | PrjReport.Add('CMP Parameters'); 101 | for K := 0 to (Comp.DM_ParameterCount - 1) do 102 | begin 103 | Param := Comp.DM_Parameters(K); 104 | PrjReport.Add(PadRight(Param.DM_Name,20) + ' = ' + Param.DM_Value); // + ' ' + Param.DM_Description); 105 | end; 106 | 107 | PrjReport.Add(''); 108 | end; // j dm_components 109 | 110 | PrjReport.Add(''); 111 | end; 112 | 113 | // report project level parameters 114 | if Prj <> Nil then 115 | begin 116 | for I := 0 to (Prj.DM_ParameterCount - 1) Do 117 | begin 118 | Param := Prj.DM_Parameters(I); 119 | PrjReport.Add(Param.DM_Name + ' ' + Param.DM_Value + ' ' + Param.DM_Description); 120 | Param.DM_ConfigurationName; 121 | Param.DM_Kind; 122 | Param.DM_RawText; 123 | 124 | Param.DM_OriginalOwner; 125 | Param.DM_Visible; 126 | end; // i prj parameters 127 | end; 128 | 129 | PrjReport.Add('=========== EOF =================================='); 130 | 131 | FilePath := ExtractFilePath(Doc.DM_FullPath); 132 | FileName := FilePath + ExtractFileName(Doc.DM_FileName) + '_RptPcbDocParas.Txt'; 133 | PrjReport.SaveToFile(FileName); 134 | PrjReport.Clear; 135 | 136 | EndHourGlass; 137 | 138 | WS := GetWorkspace; 139 | //Prj.DM_AddSourceDocument(FileName); 140 | ReportDocument := Client.OpenDocument('Text', FileName); 141 | If ReportDocument <> Nil Then 142 | begin 143 | Client.ShowDocument(ReportDocument); 144 | if (ReportDocument.GetIsShown <> 0 ) then 145 | ReportDocument.DoFileLoad; 146 | end; 147 | 148 | End; 149 | 150 | -------------------------------------------------------------------------------- /PCB/CopySUIDToClipBoard/RunScript-UUID.txt: -------------------------------------------------------------------------------- 1 | ScriptingSystem:RunScriptText 2 | Text=Begin ShowMessage(PCBServer.GetCurrentPCBBoard.SelectecObject(0).SourceUniqueId); end; 3 | 4 | Text=Begin if (PCBServer.GetCurrentPCBBoard.SelectecObjectCount > 0) then ShowMessage(PCBServer.GetCurrentPCBBoard.SelectecObject(0).SourceUniqueId); end; 5 | 6 | Text=Var B;Begin B:= PCBServer.GetCurrentPCBBoard;if(B.SelectecObjectCount > 0) then ShowMessage(B.SelectecObject(0).SourceUniqueId); end; 7 | 8 | 9 | Text=Var B,C;Begin C:=TClipboard.Create;B:=PCBServer.GetCurrentPCBBoard;C.AsText:=B.SelectecObject(0).SourceUniqueId;end; 10 | 11 | Text=Var B,C;Begin C:=TClipboard.Create;B:=PCBServer.GetCurrentPCBBoard;if(B.SelectecObjectCount>0) then C.AsText:=B.SelectecObject(0).SourceUniqueId;end; 12 | -------------------------------------------------------------------------------- /PCB/CopySUIDToClipBoard/SUIDToClipboard.pas: -------------------------------------------------------------------------------- 1 | { SUIDToClipboard.pas 2 | Copy Selected Component(s)/Footprint(s) details to Clipboard. 3 | 4 | Tests the integrity of Footprint source library 5 | 6 | BL Miller 7 | 19/09/2019 : v0.10 Initial POC 8 | } 9 | 10 | procedure CopySUIDToClipBoard; 11 | var 12 | Board : IPCB_Board; 13 | ClipB : TClipBoard; 14 | SUID : WideString; 15 | Obj : IPCB_Object; 16 | Comp : IPCB_Component; 17 | I : integer; 18 | 19 | begin 20 | Board := PCBServer.GetCurrentPCBBoard; 21 | if Board = nil then exit; 22 | 23 | ClipB := TClipboard.Create; 24 | for I := 0 to (Board.SelectecObjectCount - 1) do 25 | begin 26 | Obj := Board.SelectecObject(I); 27 | if Obj.ObjectId = eComponentObject then 28 | begin 29 | Comp := Obj; 30 | if Comp.SourceFootprintLibrary <> Comp.SourceComponentLibrary then 31 | begin 32 | ClipB.AsText:= 'Footprint Source Warning : ' + Comp.SourceFootprintLibrary + ' <> ' + Comp.SourceComponentLibrary; 33 | end; 34 | SUID := Comp.SourceDesignator; 35 | if SUID = '' then SUID := 'no desg.'; 36 | SUID := PadRight(SUID, 10); 37 | SUID := SUID + ' | ' + PadRight(Comp.Pattern, 30); 38 | SUID := SUID + ' | ' + Comp.SourceUniqueId; 39 | ClipB.AsText := SUID; 40 | end; 41 | end; 42 | ClipB.free; 43 | end; 44 | -------------------------------------------------------------------------------- /PCB/EmbedLayerColours.pas: -------------------------------------------------------------------------------- 1 | { EmbedLayerColours.pas 2 | 3 | store (& restore) PCB Board layer colours in/from the PcbDoc file. 4 | 5 | Author BL Miller 6 | 20221120 : 0.1 POC Embed colours as text in EmbedObj. 7 | } 8 | 9 | const 10 | EOColour = 'EmbeddedColours'; // specific private name of Colours 11 | 12 | var 13 | Board : IPCB_Board; 14 | PCBSysOpts : IPCB_SystemOptions; 15 | LIterator : IPCB_LayerObjectIterator; 16 | LayerObj : IPCB_LayerObject; 17 | 18 | function GetEmbeddedObj(Name : WideString) : IPCB_Embedded; forward; 19 | function AddEmbeddedObj(Name : WideString, const Desc : WideString) : IPCB_Embedded; forward; 20 | 21 | procedure RestoreColoursFromBoard; 22 | var 23 | EmbedObj : IPCB_Embedded; 24 | Name : WideString; 25 | Layer : TLayer; 26 | Data : TStringList; 27 | I : integer; 28 | Colour : WideString; 29 | begin 30 | Board := PCBServer.GetCurrentPCBBoard; 31 | If Board = Nil Then 32 | Begin 33 | ShowWarning('This document is not a PCB document!'); 34 | Exit; 35 | End; 36 | PCBSysOpts := PCBServer.SystemOptions; 37 | If PCBSysOpts = Nil Then exit; 38 | 39 | Name := EOColour; 40 | Data := TStringList.Create; 41 | Data.NameValueSeparator := '='; 42 | Data.Delimiter := '|'; 43 | 44 | EmbedObj := GetEmbeddedObj(Name); 45 | 46 | if EmbedObj <> nil then 47 | Data.DelimitedText := EmbedObj.Description 48 | else 49 | exit; 50 | 51 | LIterator := Board.LayerIterator; 52 | LIterator.First; 53 | While LIterator.Next Do 54 | Begin 55 | LayerObj := LIterator.LayerObject; 56 | Layer := LayerObj.V7_LayerID.ID; 57 | I := -1; 58 | I := Data.IndexOfName('Layer' + IntToStr(Layer)); 59 | if I > -1 then 60 | begin 61 | Colour := Data.ValueFromIndex(I); 62 | PCBSysOpts.LayerColors(Layer) := StrToInt(Colour); 63 | end; 64 | end; 65 | 66 | LIterator := Board.MechanicalLayerIterator; 67 | While LIterator.Next Do 68 | Begin 69 | Layer := LIterator.Layer; 70 | I := -1; 71 | I := Data.IndexOfName('MLayer' + IntToStr(Layer)); 72 | if I > -1 then 73 | begin 74 | Colour := Data.ValueFromIndex(I); 75 | PCBSysOpts.LayerColors(Layer) := StrToInt(Colour); 76 | end; 77 | end; 78 | 79 | Board.ViewManager_UpdateLayerTabs; 80 | ShowInfo('Layer Colours updated.'); 81 | end; 82 | 83 | procedure StoreColoursInBoard; 84 | var 85 | EmbedObj : IPCB_Embedded; 86 | Name : WideString; 87 | Layer : TLayer; 88 | Data : TStringList; 89 | I : integer; 90 | Colour : WideString; 91 | begin 92 | Board := PCBServer.GetCurrentPCBBoard; 93 | If Board = Nil Then 94 | Begin 95 | ShowWarning('This document is not a PCB document!'); 96 | Exit; 97 | End; 98 | PCBSysOpts := PCBServer.SystemOptions; 99 | If PCBSysOpts = Nil Then exit; 100 | 101 | Name := EOColour; 102 | Data := TStringList.Create; 103 | Data.NameValueSeparator := '='; 104 | Data.Delimiter := '|'; 105 | 106 | I := 0; 107 | LIterator := Board.LayerIterator; 108 | While LIterator.Next Do 109 | Begin 110 | LayerObj := LIterator.LayerObject; 111 | Layer := LayerObj.V7_LayerID.ID; 112 | // Layer := LIterator.Layer; 113 | Colour := IntToStr(PCBSysOpts.LayerColors(Layer)); 114 | Data.Add('Layer' + IntToStr(Layer) +'=' + Colour); 115 | inc(I); 116 | end; 117 | 118 | LIterator := Board.MechanicalLayerIterator; 119 | While LIterator.Next Do 120 | Begin 121 | Layer := LIterator.Layer; 122 | Colour := IntToStr(PCBSysOpts.LayerColors(Layer)); 123 | Data.Add('MLayer' + IntToStr(Layer) +'=' + Colour); 124 | inc(I); 125 | end; 126 | 127 | EmbedObj := GetEmbeddedObj(Name); 128 | 129 | Board.BeginModify; 130 | 131 | if EmbedObj <> nil then 132 | EmbedObj.Description := Data.DelimitedText 133 | else 134 | AddEmbeddedObj(Name, Data.DelimitedText); 135 | 136 | Board.EndModify; 137 | end; 138 | 139 | procedure RemoveColourEmbed; 140 | var 141 | EmbedObj : IPCB_Embedded; 142 | Name : WideString; 143 | begin 144 | Board := PCBServer.GetCurrentPCBBoard; 145 | If Board = Nil Then 146 | Begin 147 | ShowWarning('This document is not a PCB document!'); 148 | Exit; 149 | End; 150 | 151 | Name := EOColour; 152 | EmbedObj := GetEmbeddedObj(Name); 153 | 154 | if EmbedObj <> nil then 155 | begin 156 | Board.BeginModify; 157 | EmbedObj.Description := ''; 158 | Board.RemovePCBObject(EmbedObj); 159 | PCBServer.DestroyPCBObject(EmBedObj); 160 | Board.EndModify; 161 | end; 162 | end; 163 | 164 | //--------------------------------------------------------------------------------------- 165 | function GetEmbeddedObj(Name : WideString) : IPCB_Embedded; 166 | Var 167 | EmbedObj : IPCB_Embedded; 168 | BIterator : IPCB_BoardIterator; 169 | LayerSet : IPCB_LayerSet; 170 | Primitive : IPCB_Primitive; 171 | begin 172 | Result := nil; 173 | LayerSet := LayerSetUtils.CreateLayerSet.IncludeAllLayers; 174 | BIterator := Board.BoardIterator_Create; 175 | BIterator.AddFilter_ObjectSet(MkSet(eEmbeddedObject)); 176 | BIterator.AddFilter_IPCB_LayerSet(LayerSet); 177 | BIterator.AddFilter_Method(eProcessAll); 178 | 179 | EmbedObj := BIterator.FirstPCBObject; 180 | while (EmbedObj <> Nil) do 181 | begin 182 | if EmbedObj.Name = Name then 183 | Result := EmbedObj; 184 | EmbedObj := BIterator.NextPCBObject; 185 | end; 186 | Board.BoardIterator_Destroy(BIterator); 187 | end; 188 | 189 | function AddEmbeddedObj(Name : WideString, const Desc : WideString) : IPCB_Embedded; 190 | Var 191 | EmbedObj : IPCB_Embedded; 192 | begin 193 | // Embedded object created. 194 | EmbedObj := PCBServer.PCBObjectFactory(eEmbeddedObject, eNoDimension, eCreate_Default); 195 | EmbedObj.Name := Name; 196 | EmbedObj.Description := Desc; 197 | EmbedObj.Layer := LayerUtils.MechanicalLayer(1); // ?? 198 | Board.AddPCBObject(EmbedObj); 199 | Result := EmbedObj; 200 | end; 201 | 202 | 203 | 204 | -------------------------------------------------------------------------------- /PCB/LayerHacks/LayerHacking2.pas: -------------------------------------------------------------------------------- 1 | { LayerHacking2.pas 2 | Selects all objects on required mech layer "myLayer". 3 | myLayer can be InSetRange(1, 32) 4 | 5 | Why: 6 | Iterator Filters do not work with layers above eMechanical 16. 7 | Note: 8 | eMechanical17 to eMechanical32 are not defined. 9 | Board.CurrentLayer fails above eMechanical 32 & the 10 | values returned from eMech17 - 32 are very strange. 11 | Scripting API is a borked CF w.r.t. mech layers 12 | 13 | Author B. Miller 14 | 10/09/2019 : V0.1 POC 15 | 16 | } 17 | 18 | procedure SelectBadLayer; 19 | const 20 | myLayer = 29; // == eMechanical 29 21 | 22 | var 23 | PCBSysOpts : IPCB_SystemOptions; 24 | Board : IPCB_Board; 25 | LayerStack : IPCB_LayerStack_V7; 26 | Layer : TLayer; 27 | LayerName : WideString; 28 | LayerObject : IPCB_LayerObject_V7; 29 | CurrentLayer : integer; 30 | TargetLayerName : WideString; 31 | 32 | MechLayer : IPCB_MechanicalLayer; 33 | i, ML1 : integer; 34 | SLMCache : boolean; 35 | 36 | Primitive : IPCB_Primitive; 37 | ObjList : TObjectList; 38 | 39 | FileName : TPCBString; 40 | Document : IServerDocument; 41 | Rpt : TStringList; 42 | 43 | begin 44 | Board := PCBServer.GetCurrentPCBBoard; 45 | if Board = nil then exit; 46 | PCBSysOpts := PCBServer.SystemOptions; 47 | if PCBSysOpts = Nil then exit; 48 | 49 | SLMCache := PCBSysOpts.SingleLayerMode; 50 | PCBSysOpts.SingleLayerMode := true; 51 | 52 | Rpt := TstringList.Create; 53 | CurrentLayer := Board.CurrentLayer; 54 | Rpt.Add('Current layer : ' + PadRight(IntToStr(CurrentLayer),3) + ' ' + Layer2String(CurrentLayer)); 55 | 56 | // enable & display required mech layer 57 | LayerStack := Board.LayerStack_V7; 58 | ML1 := LayerUtils.MechanicalLayer(myLayer); 59 | MechLayer := LayerStack.LayerObject_V7(ML1); 60 | if not MechLayer.MechanicalLayerEnabled then 61 | begin 62 | MechLayer.MechanicalLayerEnabled := true; 63 | Rpt.Add('Mech Layer Enabled : ' + LayerUtils.AsString(ML1) ); 64 | end; 65 | if not MechLayer.IsDisplayed(Board) then 66 | begin 67 | MechLayer.IsDisplayed(Board) := true; 68 | Rpt.Add('Mech Layer Displayed : ' + LayerUtils.AsString(ML1) ); 69 | end; 70 | 71 | Board.ViewManager_UpdateLayerTabs; 72 | 73 | // cycle thru to required mech layer 74 | TargetLayerName := LayerUtils.AsString(ML1); 75 | i := 0; // rogue safety 76 | repeat 77 | ResetParameters; 78 | AddStringParameter('LayerName','Next'); 79 | RunProcess('PCB:SetCurrentLayer'); 80 | 81 | CurrentLayer := Board.CurrentLayer; 82 | 83 | LayerObject := LayerStack.LayerObject_V7(CurrentLayer); 84 | LayerName := 'Broken method NO name'; 85 | if LayerObject <> Nil then // 3 different indices for the same object info, Fg Madness!!! 86 | LayerName := LayerObject.Name; 87 | 88 | Rpt.Add( IntToStr(CurrentLayer) + ' ' + LayerUtils.AsString(CurrentLayer) + ' ' + Board.LayerName(CurrentLayer) + ' ' + LayerName); 89 | Layer2String(CurrentLayer); 90 | 91 | inc(i); 92 | until (LayerUtils.AsString(CurrentLayer) = TargetLayerName ) or (i > 100); 93 | 94 | if LayerUtils.AsString(CurrentLayer) = TargetLayerName then 95 | begin 96 | // to be sure nothing else is selected perform a deselect all 97 | ResetParameters; 98 | AddStringParameter('Scope','All'); 99 | RunProcess('PCB:Deselect'); 100 | 101 | // select all on layer. 102 | ResetParameters; 103 | AddStringParameter('Scope','Layer'); 104 | RunProcess('PCB:Select'); 105 | 106 | { Iterator := Board.BoardIterator_Create; 107 | Iterator.AddFilter_ObjectSet(MkSet(eTrackObject,eArcObject)); 108 | 109 | // >>>>> Iterator.AddFilter_LayerSet(MkSet(eMechanical1)); <<<<<<<<<< // can NOT use this 110 | 111 | Iterator.AddFilter_Method(eProcessAll); 112 | ArcOrTrack := Iterator.FirstPCBObject; // new iteration 113 | while (ArcOrTrack <> Nil) do 114 | begin 115 | ArcOrTrack.Selected := True; 116 | ArcOrTrack := Iterator.NextPCBObject; // next object in the iteration 117 | end; 118 | } 119 | 120 | // iterate selected objected & make a ObjectList. deselect any that are not trk or arc 121 | // must NOT modify iterated objects 122 | ObjList := TObjectList.Create; 123 | for i := 0 to (Board.SelectecObjectCount - 1) do 124 | begin 125 | Primitive := Board.SelectecObject [i]; 126 | if InSet(Primitive.ObjectId, MkSet(eTrackObject,eArcObject)) then 127 | ObjList.Add(Primitive); 128 | end; 129 | 130 | ResetParameters; 131 | AddStringParameter('Scope','All'); 132 | RunProcess('PCB:Deselect'); 133 | 134 | for i := 0 to (ObjList.Count - 1) do 135 | begin 136 | Primitive := ObjList.Items(i); 137 | Primitive.Selected := true; 138 | end; 139 | ObjList.Destroy; 140 | 141 | // generate new BO 142 | // ResetParameters(); 143 | // AddStringParameter('Mode', 'BOARDOUTLINE_FROM_SEL_PRIMS'); 144 | // RunProcess('PCB:PlaceBoardOutline'); 145 | 146 | 147 | end; 148 | 149 | // restore single layer mode 150 | PCBSysOpts.SingleLayerMode := SLMCache; 151 | 152 | // Display the Report 153 | FileName := ExtractFilePath(Board.FileName) + ChangefileExt(ExtractFileName(Board.FileName),'') + '-mechlayers.rep'; 154 | Rpt.SaveToFile(Filename); 155 | Rpt.Free; 156 | 157 | // comment out after debugging etc 158 | Document := Client.OpenDocument('Text', FileName); 159 | If Document <> Nil Then 160 | begin 161 | Client.ShowDocument(Document); 162 | if (Document.GetIsShown <> 0 ) then 163 | Document.DoFileLoad; 164 | end; 165 | end; 166 | {............................................. 167 | -------------------------------------------------------------------------------- /PCB/LocationJump.pas: -------------------------------------------------------------------------------- 1 | { LocationJump.pas 2 | 3 | Reads text file TAB delimited from PcbDoc folder & assumes same units as PcbDoc. 4 | # Idx X Y 5 | Idx1 x.x y.y 6 | Idx2 x.x y.y 7 | . 8 | . 9 | 10 | Inserts "Jump action" messages into MM Panel. 11 | 12 | Author: B. Miller 13 | 14/01/2023 : POC 14 | 15 | need to handle origin offset in report file. 16 | 17 | Jump action is relative to board origin. 18 | Zoom process is problematic with ZoomLevel (ZoomLevel also problem in SchServer) 19 | } 20 | 21 | const 22 | locnfile = 'locations.txt'; 23 | 24 | procedure Locations; 25 | var 26 | Board : IPCB_Board; 27 | BOL : IPCB_BoardOutline; 28 | BUnits : TUnit; 29 | BRect : TCoordRect; 30 | BOrigin : TPoint; 31 | BC : TPoint; 32 | WS : IWorkSpace; 33 | MM : IDXPMessagesManager; 34 | MMM1, MMM2 : WideString; 35 | LocnList : TStringList; 36 | LocnLine : TStringList; 37 | L : integer; 38 | LIdx : WideString; 39 | sTemp : WideString; 40 | dValue : extended; 41 | 42 | begin 43 | Board := PCBServer.GetCurrentPCBBoard; 44 | if Board = nil then exit; 45 | 46 | BUnits := Board.DisplayUnit; 47 | // GetCurrentDocumentUnit; 48 | if (BUnits = eImperial) then BUnits := eMetric 49 | else BUnits := eImperial; 50 | 51 | BC := TPoint; 52 | BOrigin := Point(Board.XOrigin, Board.YOrigin); 53 | // BRect := Board.BoundingRectangle; 54 | BOL := Board.BoardOutline; 55 | BRect := BOL.BoundingRectangle; 56 | 57 | BC.X := (BRect.X1 + BRect.X2) / 2 - BOrigin.X; 58 | BC.Y := (BRect.Y1 + BRect.Y2) / 2 - BOrigin.Y; 59 | 60 | WS := GetWorkSpace; 61 | MM := WS.DM_MessagesManager; 62 | MM.ClearMessagesForDocument(WS.DM_FocusedDocument.DM_FileName); 63 | WS.DM_ShowMessageView; 64 | MM.BeginUpdate; 65 | 66 | LocnList := TStringList.Create; 67 | LocnList.Delimiter := #10; 68 | LocnList.StrictDelimiter := true; 69 | LocnList.LoadFromFile(ExtractFilePath(Board.FileName) + locnfile); 70 | LocnLine := TStringList.Create; 71 | LocnLine.Delimiter := #9; 72 | LocnLine.StrictDelimiter := true; 73 | 74 | for L := 0 to (LocnList.Count - 1) do 75 | begin 76 | LocnLine.Delimitedtext := LocnList.Strings(L); 77 | if ansipos('#', LocnLine.Text) > 0 then continue; 78 | if LocnLine.Count > 2 then 79 | begin 80 | LIdx := LocnLine.Strings(0); 81 | sTemp := LocnLine.Strings(1); 82 | StringToCoordUnit(sTemp, dValue, BUnits); 83 | BC.X := dValue; 84 | sTemp := LocnLine.Strings(2); 85 | StringToCoordUnit(sTemp, dValue, BUnits); 86 | BC.Y := dValue; 87 | 88 | MMM1 := 'Location.X=' + CoordUnitToString(BC.X, BUnits) + ' | Location.Y=' + CoordUnitToString(BC.Y, BUnits); 89 | // Jump 90 | MMM2 := 'Object=Location | ' + MMM1; 91 | // Zoom 92 | // MMM2 := 'ZoomLevel=4|Action=Point|' + MMM1; 93 | 94 | // Jump 95 | MM.AddMessage('[Info]', 'ValorDFM violations : ' + 'Index=' + LIdx + MMM1 , 'Locations.pas', WS.DM_FocusedDocument.DM_FileName, 'PCB:Jump', MMM2, 3, false); 96 | // Zoom 97 | // MM.AddMessage('[Info]', 'ValorDFM violations : ' + 'Index=' + LIdx + ' ' + MMM1 , 'Locations.pas', WS.DM_FocusedDocument.DM_FileName, 'PCB:Zoom', MMM2, 3, false); 98 | end; 99 | end; 100 | 101 | // Client.SendMessage('PCB:ManageGridsAndGuides', 'Action=PlaceVertLineGuide',256, Client.CurrentView); 102 | // Client.SendMessage('PCB:ManageGridsAndGuides', 'Action=PlaceManualHotSpot|Location.X='+IntToStr(BC.X)+'|Location.Y='+IntToStr(BC.Y), 256, Client.CurrentView); 103 | MM.EndUpdate; 104 | WS.DM_ShowMessageView; 105 | end; 106 | -------------------------------------------------------------------------------- /PCB/PCBFilter.pas: -------------------------------------------------------------------------------- 1 | { PCBFilter.pas 2 | sanitised copy 3 | 4 | set PCB-Filter from cursor rectanglar selection 5 | 6 | Usage: 7 | If you run process or use SendMessage() with "Apply=True" and any expression then raises errors with script already running!! 8 | and user has to click select "Apply to All" to apply query expression. 9 | PostMessage() does not raise warning but ONLY executes when script exits. 10 | 11 | The DisplayUnits reversal may be fixed in later AD. 12 | 13 | 14 | Process: PCB:RunQuery 15 | Parameters :Expr=IsDesignator And (Rotation <> 0) And (Rotation <> 360)|Select=True|Mask=True 16 | Process: PCB:RunQuery 17 | Parameters: Apply=True|Source=Example|Expr=IsComment And (Hide = True)|Zoom=True|Select=True' 18 | 19 | Client.SendMessage('PCB:FilterSelect', '_Edit_=True|_Value_=IsTrack And OnTopLayer', 1024, Client.CurrentView); 20 | 21 | // Every example has true for either Apply Mask Select Zoom.. no examples of setting false. 22 | } 23 | 24 | const 25 | AD_SNAFU_Units = true; // true for AD17 26 | 27 | var 28 | Board : IPCB_Board; 29 | 30 | procedure FilterAreaSelect; 31 | var 32 | x, y, x2, y2 : TCoord; 33 | QExpression : WideString; 34 | BUnit : TUnit; 35 | 36 | begin 37 | Board := PCBServer.GetCurrentPCBBoard; 38 | if Board = nil then exit; 39 | 40 | BUnit := Board.DisplayUnit; 41 | if (AD_SNAFU_Units) then 42 | begin 43 | if (BUnit = eMM) then 44 | BUnit := eMil 45 | else 46 | BUnit := eMM; 47 | end; 48 | 49 | if Board.ChooseRectangleByCorners('Zone First Corner ','Zone Opposite Corner ', x, y, x2, y2) then 50 | begin 51 | if x > x2 then IntSwap(x, x2); 52 | if y > y2 then IntSwap(y, y2); 53 | 54 | // must be in mils for AD17 55 | if BUnit = eMil then 56 | QExpression := 'InRegionAbsolute(' + CoordUnitToStringNoUnit(x, BUnit) + ',' + CoordUnitToStringNoUnit(y, BUnit) + ',' 57 | + CoordUnitToStringNoUnit(x2, BUnit) + ',' + CoordUnitToStringNoUnit(y2, BUnit) + ')'; 58 | if BUnit = eMM then 59 | QExpression := 'InRegionAbsolute(AsMils(' + CoordUnitToStringNoUnit(x, BUnit) + '),AsMils(' + CoordUnitToStringNoUnit(y, BUnit) + ')' 60 | + ',AsMils(' + CoordUnitToStringNoUnit(x2, BUnit) + '),AsMils(' + CoordUnitToStringNoUnit(y2, BUnit) + '))'; 61 | 62 | Client.PostMessage('PCB:RunQuery', 'Expr=' + QExpression + '|Zoom=False|DeSelect=false|Select=True|Mask=True|Apply=True', 1023, Client.CurrentView); 63 | // Client.SendMessage('PCB:RunQuery', 'Expr=' + QExpression + '|Zoom=False|DeSelect=false|Select=True|Mask=True|Apply=True', 1023, Client.CurrentView); 64 | end; 65 | end; 66 | 67 | -------------------------------------------------------------------------------- /PCB/PadShapeRemoved.pas: -------------------------------------------------------------------------------- 1 | { PadShapeRemoved.pas 2 | detects pads removed from Pads & Vias (Tools / Remove Unused Pad shapes) 3 | selects these P&V & adds to report. 4 | 5 | Author : BL Miller 6 | 20231214 : 0.1 POC 7 | 20231217 : 0.11 set net override colour to Pads&Vias & highlight (select) 8 | 9 | TBD: use NetViaAntenna.pas code to detect connection to primitives on Layer. 10 | 11 | IPCB_Pad.RestoreUnusedPads; 12 | howto for Vias: copy StackSizeOnLayer() to SizeOnLayer() ?? 13 | } 14 | 15 | var 16 | PCBLib : IPCB_Library; 17 | Board : IPCB_Board; 18 | MLayerStack : IPCB_MasterLayerStack; 19 | Report : TStringList; 20 | 21 | procedure main; 22 | var 23 | LayerObj : IPCB_LayerObject; 24 | LayerClass : TLayerClassID; 25 | LS : IPCB_LayerSet; 26 | BIterator : IPCB_BoardIterator; 27 | PV : IPCB_Primitive; 28 | CMP : IPCB_Component; 29 | Layer : TLayer; 30 | ANet : IPCB_Net; 31 | NetName : WideString; 32 | CMPRefDes : WideString; 33 | bRemoved : boolean; 34 | IPCB_Via; 35 | IPCB_Pad; 36 | 37 | begin 38 | Board := PCBServer.GetCurrentPCBBoard; 39 | if Board = nil then exit; 40 | 41 | MLayerStack := Board.MasterLayerStack; 42 | LayerClass := eLayerClass_Electrical; //signal 43 | LS := LayerSetUtils.CreateLayerSet.Include(eMultiLayer); 44 | 45 | Report := TStringList.Create; 46 | 47 | // LS.IncludeInternalPlaneLayers; 48 | BIterator := Board.BoardIterator_Create; 49 | BIterator.AddFilter_IPCB_LayerSet(LS); 50 | BIterator.AddFilter_ObjectSet(MkSet(ePadObject, eViaObject)); 51 | PV := Biterator.FirstPCBObject; 52 | while PV <> nil do 53 | begin 54 | CMPRefDes := ''; 55 | NetName := 'no net'; 56 | 57 | if PV.InComponent then 58 | begin 59 | CMP := PV.Component; 60 | CMPRefDes := CMP.Name.Text; 61 | end; 62 | if PV.InNet then 63 | begin 64 | ANet := PV.Net; 65 | NetName := ANet.Name; 66 | end; 67 | 68 | LayerObj := MLayerStack.First(LayerClass); 69 | While (LayerObj <> Nil ) do 70 | begin 71 | Layer := LayerObj.V7_LayerID.ID; 72 | 73 | bRemoved := false; 74 | 75 | if PV.ObjectID = eViaObject then 76 | if PV.IntersectLayer(Layer) then 77 | if PV.SizeOnLayer(Layer) <= PV.HoleSize then 78 | bRemoved := true; 79 | 80 | if PV.ObjectId = ePadObject then 81 | if PV.IsPadRemoved(Layer) then 82 | bRemoved := true; 83 | 84 | if bRemoved then 85 | begin 86 | if PV.InNet then 87 | begin 88 | ANet.OverrideColorForDraw := true; 89 | // ANet.LiveHighlightMode := eHighlight_Thicken; // Dim; 90 | // ANet.SetState_IsHighlighted(true); 91 | // Board.AddObjectToHighlightObjectList(ANet); 92 | end; 93 | 94 | Board.AddObjectToHighlightObjectList(PV); 95 | 96 | // PV.Selected := true; 97 | // ShowMessage('PV pad removed : ' + PV.Descriptor + ' ' + Layer2String(Layer)); 98 | Report.Add(PV.Descriptor + ' | ' + Layer2String(Layer) + ' | ' + CMPRefDes + ' | ' + NetName); 99 | end; 100 | 101 | LayerObj := MLayerStack.Next(Layerclass, LayerObj); 102 | end; 103 | 104 | PV := BIterator.NextPCBObject; 105 | end; 106 | Board.BoardIterator_Destroy(BIterator); 107 | Board.GraphicallyInvalidate; 108 | Board.SetState_Navigate_HighlightObjectList(eHighlight_Dim, true); 109 | 110 | Board.ViewManager_FullUpdate; 111 | 112 | Report.SaveToFile(ExtractFilePath(Board.FileName) + 'PV-pad-removedreport.txt' ); 113 | end; 114 | 115 | procedure UnHighlightNets; 116 | var 117 | BIterator : IPCB_BoardIterator; 118 | ANet : IPCB_Net; 119 | begin 120 | Board := PCBServer.GetCurrentPCBBoard; 121 | if Board = nil then exit; 122 | BIterator := Board.BoardIterator_Create; 123 | BIterator.AddFilter_IPCB_LayerSet(LayerSetUtils.AllLayers); 124 | BIterator.AddFilter_ObjectSet(MkSet(eNetObject)); 125 | ANet := Biterator.FirstPCBObject; 126 | while ANet <> nil do 127 | begin 128 | ANet.OverrideColorForDraw := false; 129 | ANet.LiveHighlightMode := eHighlight_Graph; 130 | ANet.SetState_IsHighlighted(false); 131 | ANet.GraphicallyInvalidate; 132 | ANet.ShowNetConnects; 133 | ANet := BIterator.NextPCBObject; 134 | end; 135 | Board.BoardIterator_Destroy(BIterator); 136 | Board.GraphicallyInvalidate; 137 | Board.ViewManager_FullUpdate; 138 | end; 139 | -------------------------------------------------------------------------------- /PCB/ParallelPanPCB/PanPCB.PrjScr: -------------------------------------------------------------------------------- 1 | [Design] 2 | Version=1.0 3 | HierarchyMode=0 4 | ChannelRoomNamingStyle=0 5 | ReleasesFolder= 6 | ChannelDesignatorFormatString=$Component_$RoomName 7 | ChannelRoomLevelSeperator=_ 8 | OpenOutputs=1 9 | ArchiveProject=0 10 | TimestampOutput=0 11 | SeparateFolders=0 12 | TemplateLocationPath= 13 | PinSwapBy_Netlabel=1 14 | PinSwapBy_Pin=1 15 | AllowPortNetNames=0 16 | AllowSheetEntryNetNames=1 17 | AppendSheetNumberToLocalNets=0 18 | NetlistSinglePinNets=0 19 | DefaultConfiguration=Default - All Constraints 20 | UserID=0xFFFFFFFF 21 | DefaultPcbProtel=1 22 | DefaultPcbPcad=0 23 | ReorderDocumentsOnCompile=1 24 | NameNetsHierarchically=0 25 | PowerPortNamesTakePriority=0 26 | PushECOToAnnotationFile=1 27 | DItemRevisionGUID= 28 | ReportSuppressedErrorsInMessages=0 29 | FSMCodingStyle=eFMSDropDownList_OneProcess 30 | FSMEncodingStyle=eFMSDropDownList_OneHot 31 | OutputPath= 32 | LogFolderPath= 33 | ManagedProjectGUID= 34 | LinkedManagedProjectGUID= 35 | IncludeDesignInRelease=0 36 | 37 | [Preferences] 38 | PrefsVaultGUID= 39 | PrefsRevisionGUID= 40 | 41 | [Document1] 42 | DocumentPath=PanPCB.pas 43 | AnnotationEnabled=1 44 | AnnotateStartValue=1 45 | AnnotationIndexControlEnabled=0 46 | AnnotateSuffix= 47 | AnnotateScope=All 48 | AnnotateOrder=-1 49 | DoLibraryUpdate=1 50 | DoDatabaseUpdate=1 51 | ClassGenCCAutoEnabled=1 52 | ClassGenCCAutoRoomEnabled=1 53 | ClassGenNCAutoScope=None 54 | DItemRevisionGUID= 55 | GenerateClassCluster=0 56 | DocumentUniqueId= 57 | 58 | [Document2] 59 | DocumentPath=PanPCBForm.pas 60 | AnnotationEnabled=1 61 | AnnotateStartValue=1 62 | AnnotationIndexControlEnabled=0 63 | AnnotateSuffix= 64 | AnnotateScope=All 65 | AnnotateOrder=-1 66 | DoLibraryUpdate=1 67 | DoDatabaseUpdate=1 68 | ClassGenCCAutoEnabled=1 69 | ClassGenCCAutoRoomEnabled=1 70 | ClassGenNCAutoScope=None 71 | DItemRevisionGUID= 72 | GenerateClassCluster=0 73 | DocumentUniqueId= 74 | 75 | [Parameter1] 76 | Name=Author 77 | Value=BL Miller 78 | 79 | [Parameter2] 80 | Name=DocumentTitle 81 | Value=ParallelPanPCB 82 | 83 | [Parameter3] 84 | Name=OriginalDate 85 | Value=2023-06-10 86 | 87 | [Parameter4] 88 | Name=RevisionDate 89 | Value=2024-03-09 90 | 91 | [Parameter5] 92 | Name=VersionCode 93 | Value=0.32 94 | 95 | [Parameter6] 96 | Name=VersionForm 97 | Value=0.27 98 | 99 | [Generic_Watches] 100 | 0=Return 101 | 102 | [Generic_ScriptingSystem] 103 | StartProcName=PanPCB.pas>PanPCBs 104 | 105 | -------------------------------------------------------------------------------- /PCB/ParallelPanPCB/PanPCBForm.dfm: -------------------------------------------------------------------------------- 1 | object PanPCBForm: TPanPCBForm 2 | Left = 0 3 | Top = 0 4 | Hint = 'v0.27' 5 | Caption = 'Parallel Pan PCBs' 6 | ClientHeight = 213 7 | ClientWidth = 299 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | ShowHint = False 16 | OnClose = PanPCBFormClose 17 | OnMouseEnter = PanPCBFormMouseEnter 18 | OnMouseLeave = PanPCBFormMouseLeave 19 | OnShow = PanPCBFormShow 20 | PixelsPerInch = 96 21 | TextHeight = 13 22 | object ebCurrentPcbDoc: TEdit 23 | Left = 16 24 | Top = 16 25 | Width = 272 26 | Height = 21 27 | Hint = 'Current PcbDoc' 28 | TabOrder = 1 29 | Text = 'Focused PcbDoc/PcbLib' 30 | end 31 | object editboxSelectRow: TEdit 32 | Left = 16 33 | Top = 168 34 | Width = 200 35 | Height = 21 36 | Hint = 'Enter or Clipboard' 37 | TabOrder = 0 38 | Text = 'Cursor Location (X, Y)' 39 | end 40 | object cbOriginMode: TComboBox 41 | Left = 19 42 | Top = 142 43 | Width = 145 44 | Height = 21 45 | TabOrder = 2 46 | Text = 'Origin Modes' 47 | OnChange = cbOriginModeChange 48 | end 49 | object sbStatusBar1: TStatusBar 50 | Left = 0 51 | Top = 194 52 | Width = 299 53 | Height = 19 54 | Panels = <> 55 | end 56 | object ebFootprintName: TEdit 57 | Left = 16 58 | Top = 41 59 | Width = 272 60 | Height = 21 61 | TabOrder = 4 62 | Text = 'Selected/Focused Footprint' 63 | end 64 | object ebLibraryName: TEdit 65 | Left = 16 66 | Top = 65 67 | Width = 272 68 | Height = 21 69 | TabOrder = 5 70 | Text = 'ComponentRef / FootprintSource Libs' 71 | end 72 | object cbStrictLibrary: TCheckBox 73 | Left = 21 74 | Top = 90 75 | Width = 147 76 | Height = 17 77 | Caption = 'Strict Library Name Match' 78 | TabOrder = 6 79 | end 80 | object cbOpenLibrary: TCheckBox 81 | Left = 213 82 | Top = 90 83 | Width = 75 84 | Height = 17 85 | Caption = 'Allow Open' 86 | TabOrder = 7 87 | end 88 | object cbAnyLibPath: TCheckBox 89 | Left = 213 90 | Top = 114 91 | Width = 75 92 | Height = 17 93 | Caption = 'Any Path' 94 | TabOrder = 8 95 | OnClick = cbAnyLibPathClick 96 | end 97 | object XPDirectoryEdit1: TXPDirectoryEdit 98 | Left = 21 99 | Top = 112 100 | Width = 179 101 | Height = 21 102 | Options = [sdNewUI, sdShowFiles] 103 | StretchButtonImage = False 104 | TabOrder = 9 105 | Text = 'Search FolderPath' 106 | OnChange = XPDirectoryEdit1Change 107 | end 108 | object Timer1: TTimer 109 | OnTimer = Timer1Timer 110 | Left = 248 111 | Top = 160 112 | end 113 | end 114 | -------------------------------------------------------------------------------- /PCB/ParallelPanPCB/PanPCBForm.pas: -------------------------------------------------------------------------------- 1 | { PanPCBForm.pas 2 | part of PanPCB.PrjScr 3 | linked with PanPCBForm.dfm 4 | 20240309 0.32 (form 0.27) 5 | 6 | object sbStatusBar : TStatusBar 7 | sbStatusBar.Panels.Items(0).Text := IntToStr(Key); 8 | } 9 | Interface // this is ignored in delphiscript. 10 | type 11 | TPanPCBForm = class(TForm) 12 | editboxSelectRow : TEdit; 13 | ebCurrentPcbDoc : TEdit; 14 | cbOriginMode : TComboBox; 15 | ebFootprintName : TTextBox; 16 | ebLibraryName : TTextBox; 17 | sbStatusBar1 : TStatusBar; 18 | end; 19 | 20 | const 21 | fMouseOverForm = 0; 22 | fMouseOverTarget = 1; 23 | fTimerRunning = 3; 24 | var 25 | fState : integer; 26 | sbStatusBar1 : TStatusBar; 27 | ebFootprintName : TEdit; 28 | ebLibraryName : TEdit; 29 | cbStrictLibrary : TCheckBox; 30 | cbOpenLibrary : TCheckBox; 31 | cbAnyLibPath : TCheckBox; 32 | XPDirectoryEdit1 : TXPDirectoryEdit; 33 | 34 | 35 | function ShowForm(dummy : integer) : boolean; 36 | begin 37 | PanPCBForm.FormStyle := fsStayOnTop; 38 | PanPCBForm.Show; 39 | end; 40 | 41 | procedure TPanPCBForm.PanPCBFormShow(Sender: TObject); 42 | begin 43 | PanPCBForm.cbOriginMode.Items.AddStrings(slBoardRef); 44 | fState := fMouseOverForm; 45 | PanPCBForm.Timer1.Enabled := false; 46 | PanPCBForm.cbStrictLibrary.Checked := bExactLibName; 47 | PanPCBForm.cbOpenLibrary.Checked := bOpenLibs; 48 | PanPCBForm.cbAnyLibPath.Checked := bAnyLibPath; 49 | PanPCBForm.XPDirectoryEdit1.InitialDir := SearchPath; 50 | end; 51 | 52 | procedure TPanPCBForm.PanPCBFormClose(Sender: TObject; var Action: TCloseAction); 53 | begin 54 | PanPCBForm.Timer1.Enabled := false; 55 | CleanExit(1); 56 | end; 57 | 58 | procedure TPanPCBForm.Timer1Timer(Sender: TObject); 59 | var 60 | VC : TCoordPoint; 61 | TBoxText : WideString; 62 | begin 63 | VC := nil; 64 | TBoxText := 'no file'; 65 | bExactLibName := PanPCBForm.cbStrictLibrary.Checked; 66 | bOpenLibs := PanPCBForm.cbOpenLibrary.Checked; 67 | bAnyLibPath := PanPCBForm.cbAnyLibPath.Checked; 68 | 69 | Client.BeginDisableInterface; 70 | 71 | RefreshFocus(1); 72 | // VC := FormGetCursorView(TBoxText); 73 | VC := CurrentCPoint; 74 | TBoxText := CurrentFName; 75 | 76 | PanPCBForm.ebCurrentPcbDoc.Text := TBoxText; 77 | PanPCBForm.ebFootprintName.Text := GetCurrentFPName(1); 78 | PanPCBForm.ebLibraryName.Text := GetCurrentFPLibraryName(1); 79 | if VC <> nil then 80 | begin 81 | TBoxText := 'X' + CoordUnitToString(VC.X, eMM) + ' Y ' + CoordUnitToString(VC.Y, eMM); 82 | PanPCBForm.editboxSelectRow.Text := TBoxText; 83 | end; 84 | 85 | PanProcessAll(1); 86 | Client.EndDisableInterface; 87 | end; 88 | 89 | procedure TPanPCBForm.cbOriginModeChange(Sender: TObject); 90 | begin 91 | iBoardRef := cbOriginMode.ItemIndex; 92 | bViewPChange := true; 93 | end; 94 | 95 | procedure TPanPCBForm.editboxCurrentPcbDocClick(Sender: TObject); 96 | begin 97 | end; 98 | 99 | procedure TPanPCBForm.PanPCBFormMouseLeave(Sender: TObject); 100 | begin 101 | cbOriginMode.ItemIndex := iBoardRef; 102 | PanPCBForm.XPDirectoryEdit1.Text := SearchPath; 103 | PanPCBForm.Timer1.Enabled := true; 104 | fState := fTimerRunning; 105 | end; 106 | 107 | procedure TPanPCBForm.PanPCBFormMouseEnter(Sender: TObject); 108 | begin 109 | PanPCBForm.Timer1.Enabled := false; 110 | fState := fMouseOverForm; 111 | end; 112 | 113 | procedure TPanPCBForm.cbAnyLibPathClick(Sender: TObject); 114 | begin 115 | // immediate refresh of any other Doc with matching CMP names 116 | if not PanPCBForm.cbAnyLibPath.Checked then bCMPChange := true; 117 | if not PanPCBForm.cbAnyLibPath.Checked then exit; 118 | SearchPath := PanPCBForm.XPDirectoryEdit1.Text; 119 | end; 120 | 121 | procedure TPanPCBForm.cbStrictLibraryClick(Sender: TObject); 122 | begin 123 | // immediate refresh of any other Doc with matching CMP names 124 | if not PanPCBForm.cbStrictLibrary.Checked then bCMPChange := true;; 125 | SearchPath := PanPCBForm.XPDirectoryEdit1.Text; 126 | end; 127 | 128 | procedure TPanPCBForm.cbAllowOpenClick(Sender: TObject); 129 | begin 130 | // immediate refresh of any other Doc with matching CMP names 131 | if PanPCBForm.cbAllowOpen.Checked then bCMPChange := true;; 132 | SearchPath := PanPCBForm.XPDirectoryEdit1.Text; 133 | end; 134 | 135 | procedure TPanPCBForm.XPDirectoryEdit1Change(Sender: TObject); 136 | begin 137 | SearchPath := PanPCBForm.XPDirectoryEdit1.Text; 138 | end; 139 | 140 | -------------------------------------------------------------------------------- /PCB/README.md: -------------------------------------------------------------------------------- 1 | # Altium-DelphiScripts 2 | Scripts for Altium Designer 17/18/19. 3 | 4 | # PCB: 5 | LayerStackInfoTest / LayerStackReport-test.pas 6 | > Report all substacks & layerclasses inc. mechanical layers. 7 | 8 | CleanNets / CleanRBConnections.pas 9 | > "cleans" the rubberband Connections after scripted FP move etc. 10 | 11 | MakeExtrudedBody.pas 12 | > create a region or an extruded body from (multiple) regions or polygon outlines 13 | -------------------------------------------------------------------------------- /PCB/ReUnion.pas: -------------------------------------------------------------------------------- 1 | { ReUnion.pas 2 | 3 | ReUnion() 4 | - using pre-selected objects that is in a union, the script will: 5 | - add next clicked object(s) into same union 6 | 7 | 8 | RemoveFootprintUnion() 9 | - PcbLib remove all unions from all footprints' primitives. 10 | - PcbDoc remove all unions from selected footprint's primitives. 11 | 12 | RemoveSelectedFromUnion() 13 | - PcbDoc or PcbLib 14 | 15 | Author BL Miller 16 | 16/05/2020 v0.20 Added Remove objects from Union (free primitives & groups i.e. components) 17 | 2024-03-23 v0.21 support remove Union in PcbLibs. 18 | 19 | Add to Union 20 | Button RunScriptText 21 | Text=Var B,P,U;Begin B:=PCBServer.GetCurrentPCBBoard;if(B.SelectecObjectCount=0) then exit;P:=B.SelectecObject(0);U:=P.UnionIndex;if U=0 then exit;P:=B.GetObjectAtCursor(AllObjects,AllLayers,'pick ReUnion obj');if Assigned(P) then if P.UnionIndex=0 then P.UnionIndex := U;end; 22 | 23 | Remove from Union 24 | Text=Var B,P,U;Begin B:=PCBServer.GetCurrentPCBBoard;if(B.SelectecObjectCount=0) then exit;P:=B.SelectecObject(0);P.UnionIndex:=0;end; 25 | 26 | 27 | Script is missing some component union refresh/update trick for removing primitives from Union. 28 | close reopen PCB & Unions works perfectly.. 29 | 30 | UM := Board.BoardUnionManager; 31 | IPCB_SmartUnionObject; 32 | IPCB_SmartUnionPlaceHolder; 33 | 34 | J := IPCB_BoardUnionManager.FindUnusedUnionIndex; 35 | } 36 | 37 | function GetCurrentPcbOrLib (var IsLib : boolean) : WideString; forward; 38 | function ProcessFootprintUnions(Comp : IPCB_Component, IsLib : boolean, const UIndex) : integer; forward; 39 | 40 | var 41 | UM : IPCB_BoardUnionManager; 42 | SourceLib : IPCB_Library; 43 | Board : IPCB_Board; 44 | DocKind : Widestring; 45 | 46 | procedure ReUnion; 47 | var 48 | P,G : IPCB_Primitive; 49 | UIndex : integer; 50 | IsLib : boolean; 51 | 52 | begin 53 | IsLib := false; 54 | DocKind := GetCurrentPcbOrLib (IsLib); 55 | 56 | if(Board.SelectecObjectCount = 0) then exit; 57 | P := Board.SelectecObject(0); 58 | UIndex := P.UnionIndex; 59 | if UIndex = 0 then exit; 60 | 61 | // B.ChooseLocation(x, y, 'pick ReUnion obj'); 62 | P := nil; 63 | repeat 64 | if P <> nil then 65 | begin 66 | G := P; 67 | if P.InComponent then G := P.Component; 68 | 69 | if (G.ObjectId = eComponentObject) then 70 | begin 71 | ProcessFootprintUnions(G, IsLib, UIndex); 72 | end else 73 | begin 74 | G.BeginModify; 75 | G.SetState_UnionIndex := UIndex; 76 | G.Selected := true; 77 | G.EndModify; 78 | G.GraphicallyInvalidate; 79 | Board.ViewManager_GraphicallyInvalidatePrimitive(G); 80 | end; 81 | end; 82 | 83 | P:= Board.GetObjectAtCursor(AllObjects, AllLayers, 'pick ReUnion object(s) '); 84 | until P = nil; 85 | end; 86 | 87 | procedure RemoveFootprintUnion; 88 | var 89 | Comp : IPCB_LibComponent; 90 | Prim : IPCB_Primitive; 91 | IsLib : boolean; 92 | i : integer; 93 | 94 | begin 95 | IsLib := false; 96 | DocKind := GetCurrentPcbOrLib (IsLib); 97 | 98 | if IsLib then 99 | begin 100 | for i := 0 to (SourceLib.ComponentCount - 1) do 101 | begin 102 | Comp := SourceLib.GetComponent(i); 103 | ProcessFootprintUnions(Comp, IsLib, 0); 104 | end; 105 | // PcbDoc 106 | end else 107 | begin 108 | Comp := nil; 109 | Prim := Board.SelectecObject(0); 110 | if Prim.ObjectId = eComponentObject then Comp := Prim; 111 | if Prim.InComponent then Comp := Prim.Component; 112 | if Comp <> nil then 113 | ProcessFootprintUnions(Comp, IsLib, 0); 114 | end; 115 | end; 116 | 117 | procedure RemoveSelectedFromUnion; 118 | var 119 | Prim : IPCB_Primitive; 120 | Group : IPCB_Primitive; 121 | UIndex : integer; 122 | J : integer; 123 | IsLib : boolean; 124 | 125 | begin 126 | IsLib := false; 127 | DocKind := GetCurrentPcbOrLib (IsLib); 128 | 129 | if(Board.SelectecObjectCount = 0) then exit; 130 | 131 | for J := 0 to (Board.SelectecObjectCount - 1) do 132 | begin 133 | Prim := Board.SelectecObject(J); 134 | UIndex := Prim.UnionIndex; 135 | // if UIndex = 0 then exit; 136 | Group := Prim; 137 | if Prim.InComponent then Group := Prim.Component; 138 | 139 | Group.BeginModify; 140 | Group.SetState_UnionIndex := 0; 141 | Group.Selected := true; 142 | 143 | if (Group.ObjectId = eComponentObject) then 144 | ProcessFootprintUnions(Group, IsLib, 0); 145 | 146 | Group.EndModify; 147 | Group.GraphicallyInvalidate; 148 | Board.ViewManager_GraphicallyInvalidatePrimitive(Group); 149 | end; 150 | end; 151 | 152 | procedure ReportUnion; 153 | var 154 | Prim : IPCB_Primitive; 155 | UIndex : integer; 156 | IsLib : boolean; 157 | 158 | begin 159 | IsLib := false; 160 | DocKind := GetCurrentPcbOrLib (IsLib); 161 | 162 | if(Board.SelectecObjectCount = 0) then exit; 163 | Prim := Board.SelectecObject(0); 164 | UIndex := Prim.UnionIndex; 165 | 166 | Prim.UniqueId; 167 | ShowMessage('Union index : ' + IntToStr(UIndex)); 168 | // if UIndex = 0 then exit; 169 | end; 170 | 171 | procedure ReportDistance; 172 | var 173 | Prim1 : IPCB_Primitive; 174 | Prim2 : IPCB_Primitive; 175 | UIndex : integer; 176 | Distance : TCoord; 177 | Replicated : boolean; 178 | IsLib : boolean; 179 | begin 180 | IsLib := false; 181 | DocKind := GetCurrentPcbOrLib (IsLib); 182 | 183 | if(Board.SelectecObjectCount < 2) then exit; 184 | Prim1 := Board.SelectecObject(0); 185 | Prim2 := Board.SelectecObject(1); 186 | 187 | Replicated := false; 188 | if Prim2.Layer <> Prim1.Layer then 189 | begin 190 | Prim2 := Prim2.Replicate; 191 | Prim2.Layer := Prim1.Layer; 192 | Replicated := true; 193 | end; 194 | 195 | Distance := Board.PrimPrimDistance(Prim1, Prim2); 196 | 197 | if (Replicated) then 198 | PcbServer.DestroyPCBObject(Prim2); 199 | 200 | ShowMessage('P-P distance : ' + CoordUnitToString(Distance, eMM) ); 201 | 202 | end; 203 | 204 | function ProcessFootprintUnions(Comp : IPCB_Component, IsLib : boolean, const UIndex) : integer; 205 | var 206 | Prim : IPCB_Primitive; 207 | GIter : IPCB_GroupIterator; 208 | begin 209 | Result := 0; 210 | Comp.BeginModify; 211 | if not(IsLib) then 212 | begin 213 | Comp.SetState_UnionIndex := UIndex; 214 | Comp.Name.SetState_UnionIndex := UIndex; 215 | Comp.Comment.SetState_UnionIndex := UIndex; 216 | end; 217 | 218 | GIter := Comp.GroupIterator_Create; 219 | GIter.AddFilter_ObjectSet(AllObjects); 220 | GIter.AddFilter_LayerSet(AllLayers); 221 | Prim := GIter.FirstPCBObject; 222 | while Prim <> Nil Do 223 | begin 224 | Prim.BeginModify; 225 | Prim.SetState_UnionIndex := UIndex; 226 | Prim.EndModify; 227 | Prim := GIter.NextPCBObject; 228 | end; 229 | Comp.GroupIterator_Destroy(GIter); 230 | Comp.EndModify; 231 | Comp.GraphicallyInvalidate; 232 | Board.ViewManager_GraphicallyInvalidatePrimitive(Comp); 233 | end; 234 | 235 | function GetCurrentPcbOrLib (var IsLib : boolean) : WideString; 236 | var 237 | Document : IDocument; 238 | begin 239 | Result := ''; 240 | SourceLib := nil; 241 | IsLib := false; 242 | Document := GetWorkSpace.DM_FocusedDocument; 243 | Result := Document.DM_DocumentKind; 244 | 245 | if not ((Result = cDocKind_PcbLib) or (Result = cDocKind_Pcb)) Then 246 | begin 247 | ShowMessage('No Pcb or Lib selected. '); 248 | Result := ''; 249 | exit; 250 | end; 251 | 252 | if (Result = cDocKind_PcbLib) then 253 | IsLib := true; 254 | 255 | if IsLib then 256 | begin 257 | SourceLib := PCBServer.GetCurrentPCBLibrary; 258 | Board := SourceLib.Board; 259 | end else 260 | Board := PCBServer.GetCurrentPCBBoard; 261 | end; 262 | -------------------------------------------------------------------------------- /PCB/RedrawPlaneOutlines.pas: -------------------------------------------------------------------------------- 1 | {.............................................................................. 2 | RedrawPlaneOutlines.pas 3 | 4 | Deletes/replaces all plane outline primitives in Pcb. 5 | 6 | If run with selected object then only remove that & no auto-redraw 7 | 8 | Author: BL Miller 9 | 23/11/2022 v0.1 POC delete selected object. 10 | 11 | 12 | // eBoardOutlineObject not on plane layer 13 | // eSplitPlanePolygon returns childen ?. 14 | // eSplitPlaneObject TSplitPlaneAdaptor child one Region 15 | .............................................................................} 16 | const 17 | AutoRedrawOutlines = true; // redraw all plane outlines. 18 | StripAllOutlines = true; // remove outlines from all layers not just non-plane layers. 19 | 20 | Procedure DeleteSelectedItem; 21 | Var 22 | Board : IPCB_Board; 23 | BOLine : IPCB_BoardOutline; 24 | Prim : IPCB_Primitive; 25 | Polygon : IPCB_Polygon; 26 | Layer : TLayer; 27 | I : integer; 28 | DeleteList : TObjectList; 29 | 30 | Begin 31 | Board := PCBServer.GetCurrentPCBBoard; 32 | If Board = Nil Then 33 | Begin 34 | ShowMessage('This is not a Pcb document'); 35 | Exit; 36 | End; 37 | 38 | Prim := Board.SelectecObject(0); 39 | if Prim <> nil then 40 | begin 41 | PCBServer.PreProcess; 42 | if Prim.Enabled_vPolygon and Prim.InPolygon then 43 | begin 44 | Polygon := Prim.Polygon; //track on plane pullback TBoardOutlineAdaptor. 45 | Polygon.RemovePCBObject(Prim); 46 | end; 47 | Board.RemovePCBObject(Prim); 48 | PCBServer.DestroyPCBObject(Prim); 49 | PCBServer.PostProcess; 50 | exit; 51 | end; 52 | 53 | // only trk/arc prims "in" the boardoutline are plane borders. 54 | 55 | DeleteList := TObjectList.Create; 56 | DeleteList.OwnsObjects := false; 57 | BOLine := Board.BoardOutline; 58 | PCBServer.PreProcess; 59 | 60 | for I := 1 to BOLine.GetPrimitiveCount(Mkset(eTrackObject)) do 61 | begin 62 | Prim := BOLine.GetPrimitiveAt(I, eTrackObject); 63 | 64 | // if Prim.Layer = eMultiLayer then continue; 65 | if not StripAllOutlines then 66 | if (Prim.Layer >= eInternalPlane1) and (Prim.Layer <= eInternalPlane16) then continue; 67 | 68 | DeleteList.Add(Prim); 69 | end; 70 | 71 | for I := 1 to BOLine.GetPrimitiveCount(Mkset(eArcObject)) do 72 | begin 73 | Prim := BOLine.GetPrimitiveAt(I, eArcObject); 74 | 75 | // if Prim.Layer = eMultiLayer then continue; 76 | if not StripAllOutlines then 77 | if (Prim.Layer >= eInternalPlane1) and (Prim.Layer <= eInternalPlane16) then continue; 78 | 79 | DeleteList.Add(Prim); 80 | end; 81 | 82 | if StripAllOutlines then 83 | ShowMessage('found ' + IntToStr(DeleteList.Count) + ' polygon arc/track on any layer' ) 84 | else 85 | ShowMessage('found ' + IntToStr(DeleteList.Count) + ' rogue polygon arc/track not on plane layers' ); 86 | 87 | for I := 0 to DeleteList.Count - 1 do 88 | begin 89 | Prim := DeleteList.Items(I); 90 | Polygon := Prim.Polygon; 91 | if AutoRedrawOutlines then 92 | Polygon.BeginModify; 93 | Polygon.RemovePCBObject(Prim); 94 | if AutoRedrawOutlines then 95 | Polygon.EndModify; 96 | // Polygon.GraphicallyInvalidate; 97 | Board.RemovePCBObject(Prim); 98 | PCBServer.DestroyPCBObject(Prim); 99 | end; 100 | DeleteList.Clear; 101 | 102 | PCBServer.PostProcess; 103 | 104 | Board.GraphicallyInvalidate; 105 | Board.ViewManager_FullUpdate; 106 | End; 107 | {..............................................................................} 108 | -------------------------------------------------------------------------------- /PCB/SelectCMPInOutSideBOL.pas: -------------------------------------------------------------------------------- 1 | { SelectCMPInOutSideBOL.pas 2 | 3 | Author BL Miller 4 | 20240405 v0.10 POC 5 | } 6 | 7 | procedure SelectCMPs(const InNotOut : integer); 8 | var 9 | Board : IPCB_Board; 10 | BOL : IPCB_BoardOutline; 11 | BI : IPCB_BoardIterator; 12 | Prim : IPCB_Primitive; 13 | begin 14 | Board := PCBServer.GetCurrentPCBBoard; 15 | if Board = nil then exit; 16 | BOL := Board.BoardOutline; 17 | 18 | BI := Board.BoardIterator_Create; 19 | BI.AddFilter_ObjectSet(MkSet(eComponentObject)); 20 | BI.AddFilter_LayerSet(AllLayers); 21 | 22 | Prim := BI.FirstPCBObject; 23 | While Prim <> nil do 24 | begin 25 | if (InNotOut = eInside) then 26 | if BOL.PrimitiveInsidePoly(Prim) then 27 | Prim.Selected := true; 28 | 29 | if (InNotOut = eOutSide) then 30 | if not BOL.PrimitiveInsidePoly(Prim) then 31 | Prim.Selected := true; 32 | 33 | Prim := BI.NextPCBObject; 34 | end; 35 | Board.BoardIterator_Destroy(BI); 36 | end; 37 | 38 | procedure Inside; 39 | begin 40 | SelectCMPs(eInside); 41 | end; 42 | 43 | procedure Outside; 44 | begin 45 | SelectCMPs(eOutside); 46 | end; 47 | 48 | -------------------------------------------------------------------------------- /PCB/SimpleRegion.pas: -------------------------------------------------------------------------------- 1 | { SimpleRegion.pas 2 | 3 | B Miller 4 | 15/05/2021 : v0.10 POC. 5 | 2023-08-26 : v0.11 set masks 6 | 7 | } 8 | 9 | const 10 | ArcResolution = 0.1; // mils : impacts number of edges etc.. 11 | 12 | var 13 | Board : IPCB_Board; 14 | 15 | function AddRegionToBoard(GPC : IPCB_GeometricPolygon, Net : IPCB_Net, const Layer : TLayer, const MainContour : boolean) : IPCB_Region; forward; 16 | function GetMainContour(GPC : IPCB_GeometricPolygon) : IPCB_Contour; forward; 17 | 18 | procedure MakeRegion(); 19 | var 20 | Prim : IPCB_Primitive; 21 | Contour : IPCB_Contour; 22 | GMPC1 : IPCB_GeometricPolygon; 23 | begin 24 | Board := PCBServer.GetCurrentPCBBoard; 25 | if Board = nil then exit; 26 | 27 | PCBServer.PCBContourMaker.ArcResolution := MilsToCoord(ArcResolution); 28 | 29 | Contour := PCBServer.PCBContourFactory; // PCBServer.PCBGeometricPolygonFactory.AddEmptyContour; 30 | Contour.AddPoint(MilsToCoord(1000), MilsToCoord(1000)); 31 | Contour.AddPoint(MilsToCoord(1000),MilsToCoord(3000)); 32 | PCBServer.PCBContourMaker.AddArcToContour(Contour, 90,0,MilsToCoord(1000),MilsToCoord(2000), MilsToCoord(1000), true); 33 | Contour.AddPoint(MilsToCoord(2000),MilsToCoord(1000)); 34 | 35 | GMPC1 := PcbServer.PCBGeometricPolygonFactory; 36 | GMPC1.AddContour(Contour); 37 | 38 | // Add holes ? 39 | Contour := PCBServer.PCBContourFactory; 40 | Contour.AddPoint(MilsToCoord(1300),MilsToCoord(1500)); 41 | Contour.AddPoint(MilsToCoord(1700),MilsToCoord(1500)); 42 | PCBServer.PCBContourMaker.AddArcToContour(Contour, 0,180,MilsToCoord(1500),MilsToCoord(1500), MilsToCoord(200), false); 43 | // PCBServer.PCBContourMaker.AddArcToContour(Contour, 180,360,MilsToCoord(1500),MilsToCoord(1500), MilsToCoord(200), false); 44 | GMPC1.AddContourIsHole(Contour, true); 45 | // GMPC1.IsHole(1); 46 | 47 | Prim := AddRegionToBoard(GMPC1, nil, eTopLayer, False); 48 | Prim.Selected := true; 49 | Client.SendMessage('PCB:Zoom', 'Action=Selected', 512, Client.CurrentView); 50 | end; 51 | 52 | function AddRegionToBoard(GPC : IPCB_GeometricPolygon, Net : IPCB_Net, const Layer : TLayer, const MainContour : boolean) : IPCB_Region; 53 | var 54 | GPCVL : Pgpc_vertex_list; 55 | begin 56 | PCBServer.PreProcess; 57 | Result := PCBServer.PCBObjectFactory(eRegionObject, eNoDimension, eCreate_Default); 58 | PCBServer.SendMessageToRobots(Result.I_ObjectAddress, c_Broadcast, PCBM_BeginModify, c_NoEventData); 59 | 60 | // if main outer contour is index (0) then can just use GPC.Contour(0) 61 | if MainContour and (GPC.Count > 1) then 62 | Result.SetOutlineContour( GetMainContour(GPC)) // GPC.Contour(0)) 63 | else 64 | begin 65 | Result.GeometricPolygon := GPC; 66 | end; 67 | 68 | Result.SetState_Kind(eRegionKind_Copper); 69 | Result.SetState_IsKeepout(false); 70 | Result.SetState_SolderMaskExpansionMode (eMaskExpansionMode_NoMask); 71 | Result.SetState_PasteMaskExpansionMode (eMaskExpansionMode_NoMask); 72 | Result.Layer := Layer; 73 | Result.Net := Net; 74 | // Result.UnionIndex := UIndex; 75 | 76 | Board.AddPCBObject(Result); 77 | PCBServer.SendMessageToRobots(Result.I_ObjectAddress, c_Broadcast, PCBM_EndModify, c_NoEventData); 78 | PCBServer.SendMessageToRobots(Board.I_ObjectAddress, c_Broadcast, PCBM_BoardRegisteration, Result.I_ObjectAddress); 79 | PCBServer.PostProcess; 80 | Result.GraphicallyInvalidate; 81 | end; 82 | 83 | function GetMainContour(GPC : IPCB_GeometricPolygon) : IPCB_Contour; 84 | var 85 | CArea, MArea : double; 86 | I : integer; 87 | begin 88 | Result := PCBServer.PCBContourFactory; 89 | MArea := 0; 90 | for I := 0 to (GPC.Count - 1) do 91 | begin 92 | CArea := GPC.Contour(I).Area; 93 | if CArea > MArea then 94 | begin 95 | MArea := CArea; 96 | Result := GPC.Contour(I); 97 | end; 98 | end; 99 | end; 100 | -------------------------------------------------------------------------------- /PCB/ToggleSolderMasks02.pas: -------------------------------------------------------------------------------- 1 | { ToogleSolderMasks02.pas 2 | 3 | 4 | PCB:SetupPreferences 5 | PositiveTopSolderMask=Toggle 6 | } 7 | 8 | procedure ToggleSM; 9 | var 10 | Board : IPCB_Board; 11 | 12 | begin 13 | If PcbServer = Nil Then Exit; 14 | Board := PcbServer.GetCurrentPCBBoard; 15 | 16 | Client.SendMessage('PCB:SetupPreferences', 'PositiveTopSolderMask=Toggle', 256, Client.CurrentView); 17 | Client.SendMessage('PCB:SetupPreferences', 'PositiveBottomSolderMask=Toggle', 256, Client.CurrentView); 18 | 19 | // required AD17 20 | Client.SendMessage('PCB:Zoom', 'Action = Redraw', 256, Client.CurrentView); 21 | 22 | // more required AD21.9 23 | Board.ViewManager_UpdateLayerTabs; 24 | // is this enough to replace above ? 25 | PcbServer.RefreshDocumentView(Board.FileName); 26 | end; 27 | -------------------------------------------------------------------------------- /PCB/ToogleModels.pas: -------------------------------------------------------------------------------- 1 | { ToggleModels.pas 2 | 3 | Cycles thru the 4 possible states of the (2) settings for ShowBodies (extruded) & ShowStepModels 4 | 5 | Many options/pref settings are missing in API so just retrieve from source. 6 | 7 | If just need to toggle one value then do not need to read existing. 8 | Client.SendMessage('Pcb:SetupPreferences','ShowComponentStepModels=toggle', 255, Client.CurrentView); 9 | 10 | Write back to registry to cache current settings as no obvious way to trigger Altium to do this 11 | or to trigger a refresh of server if we change the registry. 12 | 13 | 06/06/2021 BLM v0.10 POC works in AD17. 14 | } 15 | 16 | const 17 | cNameOfServer = 'AdvPCB'; 18 | cSectionName = 'SystemOptions'; 19 | cIniFileName = 'Pcb_Display.ini'; 20 | // [PcbPref_Display] 21 | cShowComponentBodies = 'ShowComponentBodies'; 22 | cShowComponentStepModels = 'ShowComponentStepModels'; 23 | 24 | var 25 | Board : IPCB_Board; 26 | Reader : IOptionsReader; 27 | Writer : IOptionsWriter; 28 | 29 | procedure ToogleCompBodyAndModel; 30 | var 31 | CurrentStep : boolean; 32 | CurrentExtruded : boolean; 33 | 34 | begin 35 | // If PcbServer = Nil Then 36 | // Client.StartServer('PCB'); 37 | If PcbServer = Nil Then Exit; 38 | 39 | // Board := PcbServer.GetCurrentPCBBoard; 40 | // If Board = Nil Then Exit; 41 | 42 | CurrentExtruded := false; 43 | CurrentStep := false; 44 | 45 | Reader := Client.OptionsManager.GetOptionsReader(cNameOfServer,''); 46 | if not (Reader.SectionExists(cSectionName) = -1) then exit; 47 | 48 | CurrentExtruded := StrToBool(Reader.ReadString(cSectionName, cShowComponentBodies, '0')); 49 | CurrentStep := StrToBool(Reader.ReadString(cSectionName, cShowComponentStepModels, '0')); 50 | 51 | Writer := Client.OptionsManager.GetOptionsWriter(cNameOfServer); 52 | 53 | Client.SendMessage('PCB:SwitchTo3D', '', 255, Client.CurrentView); // SwitchTo2D3D 54 | 55 | if (not CurrentStep) and (not CurrentExtruded) then 56 | begin 57 | Client.SendMessage('Pcb:SetupPreferences','ShowComponentStepModels=true', 255, Client.CurrentView); 58 | Writer.WriteString(cSectionName, cShowComponentStepModels, '1'); 59 | end; 60 | 61 | if (CurrentStep) and (not CurrentExtruded) then 62 | begin 63 | Client.SendMessage('Pcb:SetupPreferences','ShowComponentBodies=true', 255, Client.CurrentView); 64 | Writer.WriteString(cSectionName, cShowComponentBodies, '1'); 65 | end; 66 | 67 | if (CurrentStep and CurrentExtruded) then 68 | begin 69 | Client.SendMessage('Pcb:SetupPreferences','ShowComponentStepModels=false', 255, Client.CurrentView); 70 | Client.SendMessage('Pcb:SetupPreferences','ShowComponentBodies=false', 255, Client.CurrentView); 71 | Writer.WriteString(cSectionName, cShowComponentStepModels, '0'); 72 | Writer.WriteString(cSectionName, cShowComponentBodies, '0'); 73 | end; 74 | 75 | // PcbServer.SystemOptions.ShowComponentBodies := CurrentExtruded; 76 | 77 | Client.SendMessage('PCB:Zoom', 'Action=Redraw', 255, Client.CurrentView); 78 | 79 | end; 80 | -------------------------------------------------------------------------------- /PcbLib/DeleteSelectedItemsInPcbLib.pas: -------------------------------------------------------------------------------- 1 | {.............................................................................. 2 | DeleteSelectedItemsInPcbLibParts.pas 3 | 4 | Deletes all selected primitives in PcbLib. 5 | Iterate and find Selected Objects for all footprints within the current library. 6 | 7 | Use FSO FindSimilarObjects filter UI to preselect objects. 8 | 9 | Created by: Colby Siemer 10 | Modified by: BL Miller 11 | 12 | 24/07/2020 v1.1 fix one object not deleting (the actual user picked obj) 13 | 25/07/2020 v1.2 set focused doc / current view as "dirty" as required. 14 | 26/07/2020 v1.3 Using temp FP list finally solves problem. Use create TempComp in middle. 15 | 15/08/2020 v1.4 Take temp FP ObjectList soln from 02.pas (26/07/2020) 16 | 07/01/2021 v1.5 Try again with TInterfaceList & rearranged Delete() outside of GroupIterator 17 | 08/01/2021 v1.6 Added StatusBar percentage delete progress & Cursor busy. 18 | 03/07/2022 v1.7 refactor FP iterating simplify deleting with another objectlist. 19 | 2023-10-22 v1.8 add dialog to allow optional bypass limit to cMaxObjects count 20 | 2024-05-21 v1.9 reorder Remove & Deregister 21 | 22 | 1000 primitives takes 2:30 mins & 1GB ram 23 | 24 | Can NOT delete primitives that are referenced inside an iterator as this messes up "indexing". 25 | Must re-create the iterator after any object deletion. 26 | Use of TInterfaceList (for external dll calls etc) may not be required. 27 | 28 | Creating a temporary component is required. 29 | Selecting Comp with CurrentLib.SetState_CurrentComponent(TempPcbLibComp) clears all selections. 30 | 31 | delete footprint.. 32 | CurrentLib.DeRegisterComponent(TempPCBLibComp); 33 | PCBServer.DestroyPCBLibComp(TempPCBLibComp); 34 | ..............................................................................} 35 | 36 | const 37 | cMaxObjects = 1000; // safe low number 38 | FP = '___TemporaryComponent__DeleteMeWhenDone___'; // name for temp FP comp. 39 | 40 | Procedure DeleteSelectedItemsFromFootprints; 41 | Var 42 | GUIMan : IGUIManager; 43 | CurrentLib : IPCB_Library; 44 | TempPCBLibComp : IPCB_LibComponent; 45 | 46 | FIterator : IPCB_LibraryIterator; 47 | GIterator : IPCB_GroupIterator; 48 | Footprint : IPCB_LibComponent; 49 | 50 | FPList : TObjectList; 51 | DeleteList : TObjectList; 52 | FPDeleteList : TObjectList; 53 | I, J, K : Integer; 54 | MyPrim : IPCB_Primitive; 55 | Prim2 : IPCB_Primitive; 56 | 57 | HowMany : String; 58 | HowManyInt : Integer; 59 | SelCountTot : integer; 60 | MaxObjects : integer; 61 | intDialog : Integer; 62 | Remove : boolean; 63 | First : boolean; // control (limit) LibCompList to ONE instance. 64 | sStatusBar : WideString; 65 | iStatusBar : integer; 66 | 67 | Begin 68 | GUIMan := Client.GUIManager; 69 | 70 | CurrentLib := PCBServer.GetCurrentPCBLibrary; 71 | If CurrentLib = Nil Then 72 | Begin 73 | ShowMessage('This is not a PcbLib document'); 74 | Exit; 75 | End; 76 | 77 | // Verify user wants to continue, if cancel pressed, exit script. If OK, continue 78 | intDialog := MessageDlg('!!! Operation can NOT be undone, proceed with caution !!! ', mtWarning, mbOKCancel, 0); 79 | if intDialog = mrCancel then 80 | begin 81 | ShowMessage('Cancel pressed. Exiting '); 82 | Exit; 83 | end; 84 | 85 | DeleteList := TObjectList.Create; 86 | DeleteList.OwnsObjects := false; 87 | FPList := TObjectList.Create; // hold a list of affected LibComponents. 88 | FPList.OwnsObjects := false; 89 | 90 | SelCountTot := 0; 91 | HowManyInt := 0; 92 | 93 | for I := 0 to (CurrentLib.ComponentCount - 1) do 94 | begin 95 | Footprint := CurrentLib.GetComponent(I); 96 | First := true; 97 | 98 | GIterator := Footprint.GroupIterator_Create; 99 | // Use a line such as the following if you would like to limit the type of items you are allowed to delete, in the example line below, 100 | // this would limit the script to Component Body Objects 101 | // GIterator.Addfilter_ObjectSet(MkSet(eComponentBodyObject)); 102 | 103 | MyPrim := GIterator.FirstPCBObject; 104 | while MyPrim <> Nil Do 105 | begin 106 | if MyPrim.Selected = true then 107 | begin 108 | if (First) then FPList.Add(Footprint); 109 | First := false; 110 | DeleteList.Add(MyPrim); 111 | inc(SelCountTot); 112 | end; 113 | MyPrim := GIterator.NextPCBObject; 114 | end; 115 | Footprint.GroupIterator_Destroy(GIterator); 116 | end; 117 | 118 | // these are cleared again by focusing the temp component.. 119 | CurrentLib.Board.SelectedObjects_BeginUpdate; 120 | CurrentLib.Board.SelectedObjects_Clear; 121 | CurrentLib.Board.SelectedObjects_EndUpdate; 122 | 123 | // Create a temporary component to hold focus while we delete items 124 | TempPCBLibComp := PCBServer.CreatePCBLibComp; 125 | TempPcbLibComp.Name := FP; 126 | CurrentLib.RegisterComponent(TempPCBLibComp); 127 | 128 | // focus the temp footprint 129 | CurrentLib.SetState_CurrentComponent(TempPcbLibComp); 130 | CurrentLib.Board.ViewManager_FullUpdate; // update all panels assoc. with PCB 131 | CurrentLib.RefreshView; 132 | 133 | MaxObjects := DeleteList.Count; 134 | if MaxObjects > cMaxObjects then 135 | begin 136 | intDialog := MessageDlg('Selected Count greater than MaxObjects, Limit Delete Count to ' + IntToStr(cMaxObjects) + ' ?', mtConfirmation, mbYesNo, 0); 137 | if intDialog = mrYes then 138 | MaxObjects := cMaxObjects; 139 | end; 140 | 141 | BeginHourGlass(crHourGlass); 142 | PCBServer.PreProcess; 143 | 144 | FPDeleteList := TObjectList.Create; // hold a list of prims in a FP to delete. 145 | FPDeleteList.OwnsObjects := false; 146 | 147 | for I := 0 to (FPList.Count - 1) do 148 | begin 149 | Footprint := FPList.Items(I); 150 | 151 | iStatusBar := Int(HowManyInt / SelCountToT * 100); 152 | sStatusBar := ' Deleting : ' + IntToStr(iStatusBar) + '% done'; 153 | GUIMan.StatusBar_SetState (1, sStatusBar); 154 | 155 | // can NOT delete Prim without re-creating the Group Iterator. 156 | // so make another list to delete from 157 | 158 | GIterator := Footprint.GroupIterator_Create; 159 | MyPrim := GIterator.FirstPCBObject; 160 | while MyPrim <> Nil Do 161 | begin 162 | for J := 0 to (MaxObjects - 1) do 163 | begin 164 | Prim2 := DeleteList.Items(J); 165 | if (MyPrim.I_ObjectAddress = Prim2.I_ObjectAddress) then 166 | begin 167 | FPDeleteList.Add(Prim2); 168 | // can only match once so jump out 169 | break; 170 | end; 171 | end; 172 | 173 | MyPrim := GIterator.NextPCBObject; 174 | end; 175 | Footprint.GroupIterator_Destroy(GIterator); 176 | 177 | for J := 0 to (FPDeleteList.Count - 1) do 178 | begin 179 | Prim2 := FPDeleteList.Items(J); 180 | Footprint.RemovePCBObject(Prim2); 181 | PCBServer.DestroyPCBObject(Prim2); 182 | inc(HowManyInt); 183 | end; 184 | FPDeleteList.Clear; 185 | 186 | end; 187 | 188 | FPDeleteList.Free; 189 | DeleteList.Clear; 190 | DeleteList.Free; 191 | FPList.Clear; 192 | FPList.Destroy; 193 | 194 | PCBServer.PostProcess; 195 | 196 | CurrentLib.Board.GraphicallyInvalidate; 197 | 198 | // Delete Temporary Footprint 199 | CurrentLib.RemoveComponent(TempPcbLibComp); 200 | CurrentLib.DeRegisterComponent(TempPcbLibComp); 201 | PcbServer.DestroyPCBLibComp(TempPcbLibComp); 202 | 203 | CurrentLib.Navigate_FirstComponent; 204 | CurrentLib.Board.ViewManager_FullUpdate; 205 | CurrentLib.Board.GraphicalView_ZoomRedraw; 206 | CurrentLib.RefreshView; 207 | EndHourGlass; 208 | 209 | if HowManyInt > 0 then CurrentLib.Board.SetState_DocumentHasChanged; 210 | 211 | HowMany := IntToStr(HowManyInt); 212 | if HowManyInt = 0 then HowMany := '-NO-'; 213 | ShowMessage('Deleted ' + HowMany + ' Items | selected count : ' + IntToStr(SelCountTot) ); 214 | End; 215 | {..............................................................................} 216 | 217 | -------------------------------------------------------------------------------- /PcbLib/LibraryCompFPsWithSelectedPrimitives.pas: -------------------------------------------------------------------------------- 1 | {Show Library footprints that have selected primitives. 2 | Works on PcbLib 3 | Select primitives from multiple footprints using PCBLIB List or Filter panel 4 | or Find Selected Objects and use the "Whole Library" option. 5 | Displays selected primitives as selected in the Parent footprint 6 | and lists the primitives viewed in the ClipBoard. 7 | 8 | Attempts to reselect all primitives (not completely successfully) 9 | 10 | Modified Brett Miller 2023-06-05 11 | By Eric Albach 2020-02-28 12 | Based on Altium's LibraryIterator.pas script 13 | 14 | DNW in PcbLib sadly.. does NOT jump/navigate to next footprint 15 | PCB:Jump 16 | Parameters : Object = Selected | Type = Next 17 | 18 | } 19 | 20 | Procedure ShowFootprints; 21 | Var 22 | CurrentLib : IPCB_Library; 23 | Footprint : IPCB_LibComponent; 24 | APrim : IPCB_Primitive; 25 | APrim2 : IPCB_Primitive; 26 | Iterator : IPCB_GroupIterator; 27 | PrimList : TObjectList; 28 | 29 | bFirstTime : Boolean; 30 | bFinished : boolean; 31 | NoOfPrims : Integer; 32 | SL : TStringlist; 33 | ClipB : TClipboard; 34 | intDialog : Integer; 35 | I, J : integer; 36 | ObjSet : TSet; 37 | 38 | Begin 39 | CurrentLib := PCBServer.GetCurrentPCBLibrary; 40 | If CurrentLib = Nil Then 41 | Begin 42 | ShowMessage('This is not a PCB Library document'); 43 | Exit; 44 | End; 45 | 46 | if CurrentLib.Board.SelectedObjectsCount = 0 then exit; 47 | 48 | PrimList := TObjectList.Create; 49 | PrimList.OwnsObjects := false; 50 | ObjSet := MkSet(); 51 | 52 | // cache selected objs as FP select for origin & bounding rect will destroy state. 53 | for I := 0 to (CurrentLib.Board.SelectedObjectsCount - 1) do 54 | begin 55 | APrim := CurrentLib.Board.SelectecObject(I); 56 | PrimList.Add(APrim); 57 | if not InSet(APrim.ObjectId, ObjSet) then 58 | ObjSet := SetUnion(Objset, MkSet(APrim.ObjectId)); 59 | end; 60 | 61 | SL := TStringList.Create; 62 | bFirstTime := True; 63 | bFinished := false; 64 | 65 | CurrentLib.Navigate_FirstComponent; 66 | CurrentLib.Board.ViewManager_FullUpdate; // required else zoom focus is wrong sometimes! 67 | 68 | for I := 0 to (CurrentLib.ComponentCount - 1) do 69 | begin 70 | Footprint := CurrentLib.GetComponent(I); 71 | CurrentLib.SetState_CurrentComponent(Footprint); // this unselects all objects 72 | CurrentLib.RefreshView; 73 | 74 | If bFirstTime Then 75 | Begin 76 | SL.Add(ExtractFileName(Footprint.Board.FileName)); 77 | SL.Add(''); 78 | SL.Add('These footprint had selected Primitives:'); 79 | End; 80 | bFirstTime := False; 81 | 82 | NoOfPrims := Footprint.GetPrimitiveCount(AllObjects); 83 | 84 | Iterator := Footprint.GroupIterator_Create; 85 | Iterator.SetState_FilterAll; 86 | Iterator.AddFilter_IPCB_LayerSet(LayerSetUtils.AllLayers); 87 | Iterator.AddFilter_ObjectSet(ObjSet); 88 | APrim := Iterator.FirstPCBObject; 89 | While (APrim <> Nil) Do 90 | Begin 91 | for J := 0 to (PrimList.Count - 1) do 92 | begin 93 | APrim2 := PrimList.Items(J); 94 | 95 | if (APrim.I_ObjectAddress = APrim2.I_ObjectAddress) then 96 | begin 97 | SL.Add(Footprint.Name + ' | ' + APrim.ObjectIDString + ' | ' + APrim.Detail); 98 | 99 | APrim.SetState_Selected(true); 100 | APrim.GraphicallyInvalidate; 101 | Client.SendMessage('PCB:Jump', 'Object=Selected', 255, Client.CurrentView); 102 | Client.SendMessage('PCB:Zoom', 'ZoomLevel=10.0|Action=Redraw', 255, Client.CurrentView); 103 | 104 | intDialog := MessageDlg(Footprint.Name + ' | ' + APrim.ObjectIDString + ' - Show Next ? ', mtConfirmation, mbOKCancel, 0); 105 | if intDialog = mrCancel then 106 | begin 107 | bFinished := true; 108 | SL.Add('exited before all listed..'); 109 | break; 110 | end; 111 | end; 112 | end; 113 | 114 | if bFinished then break; 115 | 116 | APrim := Iterator.NextPCBObject; 117 | End; 118 | Footprint.GroupIterator_Destroy(Iterator); 119 | if bFinished then break; 120 | End; 121 | 122 | ShowMessage(SL.Text); 123 | // this ONLY seems to work on the focused footprint.. 124 | CurrentLib.Board.SelectedObjects_BeginUpdate; 125 | CurrentLib.Board.SelectedObjects_Clear; 126 | for I := 0 to (PrimList.Count) - 1 do 127 | CurrentLib.Board.SelectedObjects_Add(PrimList.Items(I)); 128 | CurrentLib.Board.SelectedObjects_EndUpdate; 129 | 130 | PrimList.Destroy; 131 | 132 | ClipB := TClipboard.Create; 133 | ClipB.AsText := StringReplace(SL.Text, #10, #13#10, rfReplaceAll); 134 | SL.Clear; 135 | ClipB.free; 136 | End; 137 | {..............................................................................} 138 | 139 | -------------------------------------------------------------------------------- /PcbLib/MakeRegionShapes/Screenshot from 2022-10-14 10-04-39.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BrettLMiller/Altium-DelphiScripts/a50febb06dc8c5f8b24a08b8019481e273b588f3/PcbLib/MakeRegionShapes/Screenshot from 2022-10-14 10-04-39.png -------------------------------------------------------------------------------- /PcbLib/MakeRegionShapes/Screenshot from 2022-10-15 08-50-52.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BrettLMiller/Altium-DelphiScripts/a50febb06dc8c5f8b24a08b8019481e273b588f3/PcbLib/MakeRegionShapes/Screenshot from 2022-10-15 08-50-52.png -------------------------------------------------------------------------------- /PcbLib/MechLayerMapping/PCBLibrariesDefault01.ini: -------------------------------------------------------------------------------- 1 | [MechLayer1] 2 | Name=PCB Outline 3 | Enabled=0 4 | Kind=Not Set 5 | Show=0 6 | Sheet=0 7 | SLM=0 8 | Color=clFuchsia 9 | [MechLayer2] 10 | Name=Mechanical 2 11 | Enabled=1 12 | Kind=Not Set 13 | Show=0 14 | Sheet=0 15 | SLM=0 16 | Color=clPurple 17 | [MechLayer3] 18 | Name=Mechanical 3 19 | Enabled=0 20 | Kind=Not Set 21 | Show=1 22 | Sheet=0 23 | SLM=0 24 | Color=$00C7A956 25 | [MechLayer4] 26 | Name=Mechanical 4 27 | Enabled=0 28 | Kind=Not Set 29 | Show=0 30 | Sheet=0 31 | SLM=0 32 | Color=clOlive 33 | [MechLayer5] 34 | Name=Mechanical 5 35 | Enabled=0 36 | Kind=Not Set 37 | Show=0 38 | Sheet=0 39 | SLM=0 40 | Color=$008E0033 41 | [MechLayer6] 42 | Name=Mechanical 6 43 | Enabled=0 44 | Kind=Not Set 45 | Show=0 46 | Sheet=0 47 | SLM=0 48 | Color=clPurple 49 | [MechLayer7] 50 | Name=Mechanical 7 51 | Enabled=0 52 | Kind=Not Set 53 | Show=0 54 | Sheet=0 55 | SLM=0 56 | Color=clGreen 57 | [MechLayer8] 58 | Name=Mechanical 8 59 | Enabled=0 60 | Kind=Not Set 61 | Show=0 62 | Sheet=0 63 | SLM=0 64 | Color=clOlive 65 | [MechLayer9] 66 | Name=Mechanical 9 67 | Enabled=0 68 | Kind=Not Set 69 | Show=0 70 | Sheet=0 71 | SLM=0 72 | Color=$002E619F 73 | [MechLayer10] 74 | Name=Mechanical 10 75 | Enabled=0 76 | Kind=Not Set 77 | Show=0 78 | Sheet=0 79 | SLM=0 80 | Color=clMaroon 81 | [MechLayer11] 82 | Name=Top 3D Body 83 | Enabled=1 84 | Kind=3D Body Top 85 | Show=0 86 | Sheet=0 87 | SLM=0 88 | Color=$002E619F 89 | Pair=Bottom 3D Body 90 | PairKind=3D Body 91 | [MechLayer12] 92 | Name=Bottom 3D Body 93 | Enabled=1 94 | Kind=3D Body 95 | Show=0 96 | Sheet=0 97 | SLM=0 98 | Color=clOlive 99 | Pair=Top 3D Body 100 | PairKind=3D Body 101 | [MechLayer13] 102 | Name=Assembly Top 103 | Enabled=1 104 | Kind=Assembly 105 | Show=1 106 | Sheet=0 107 | SLM=0 108 | Color=$008D98A9 109 | Pair=Assembly Bottom 110 | PairKind=Assembly 111 | [MechLayer14] 112 | Name=Assembly Bottom 113 | Enabled=1 114 | Kind=Assembly 115 | Show=0 116 | Sheet=0 117 | SLM=0 118 | Color=$006E0066 119 | Pair=Assembly Top 120 | PairKind=Assembly 121 | [MechLayer15] 122 | Name=Courtyard Top 123 | Enabled=1 124 | Kind=Courtyard 125 | Show=1 126 | Sheet=0 127 | SLM=0 128 | Color=clGreen 129 | Pair=Courtyard Bottom 130 | PairKind=Courtyard 131 | [MechLayer16] 132 | Name=Courtyard Bottom 133 | Enabled=1 134 | Kind=Courtyard 135 | Show=0 136 | Sheet=0 137 | SLM=0 138 | Color=clBlack 139 | Pair=Courtyard Top 140 | PairKind=Courtyard 141 | [MechLayer17] 142 | Name=Top Component 143 | Enabled=1 144 | Kind=Not Set 145 | Show=1 146 | Sheet=0 147 | SLM=0 148 | Color=clGreen 149 | Pair=Bottom Component 150 | PairKind=none 151 | [MechLayer18] 152 | Name=Bottom Component 153 | Enabled=1 154 | Kind=Not Set 155 | Show=0 156 | Sheet=0 157 | SLM=0 158 | Color=clBlack 159 | Pair=Top Component 160 | PairKind=none 161 | [MechLayer19] 162 | Name=Top Terminal 163 | Enabled=1 164 | Kind=Not Set 165 | Show=1 166 | Sheet=0 167 | SLM=0 168 | Color=clGreen 169 | Pair=Bottom Terminal 170 | PairKind=none 171 | [MechLayer20] 172 | Name=Bottom Terminal 173 | Enabled=1 174 | Kind=Not Set 175 | Show=0 176 | Sheet=0 177 | SLM=0 178 | Color=clBlack 179 | Pair=Top Terminal 180 | PairKind=none 181 | -------------------------------------------------------------------------------- /PcbLib/SplitFootprintMechLayers.pas: -------------------------------------------------------------------------------- 1 | {.............................................................................. 2 | SplitFootprintMechLayers.pas 3 | 4 | Author: BL Miller 5 | 6 | 2024-03-23 0.1 POC 7 | 2024-03-24 0.2 determine mech layers used first, more scalable with 1024 layers! 8 | 2024-03-27 0.21 approximate percentage complete statusbar & run time. 9 | 10 | Notes: 11 | Can NOT delete primitives that are referenced inside an iterator as this messes up "indexing". 12 | Must re-create the iterator after any object deletion. 13 | Can NOT delete primitives if FP is "current" 14 | Selecting Comp with CurrentLib.SetState_CurrentComponent(TempPcbLibComp) clears all selections. 15 | 16 | delete footprint.. 17 | CurrentLib.DeRegisterComponent(TempPCBLibComp); 18 | PCBServer.DestroyPCBLibComp(TempPCBLibComp); 19 | ..............................................................................} 20 | 21 | const 22 | AD19VersionMajor = 19; 23 | AD17MaxMechLayers = 32; 24 | AD19MaxMechLayers = 1024; 25 | cStatusUpdate = 500; 26 | 27 | var 28 | VerMajor : integer; 29 | MaxMechLayers : integer; 30 | LegacyMLS : boolean; 31 | GUIMan : IGUIManager; 32 | 33 | function GetMechLayerObject(LS: IPCB_MasterLayerStack, const i : integer, var MLID : TLayer) : IPCB_MechanicalLayer; forward; 34 | 35 | Procedure SplitFootprint; 36 | Var 37 | CurrentLib : IPCB_Library; 38 | Board : IPCB_Board; 39 | LayerStack : IPCB_LayerStack; 40 | SComp : IPCB_LibComponent; 41 | NewFP : IPCB_LibComponent; 42 | GIterator : IPCB_GroupIterator; 43 | FPList : TObjectList; 44 | i, j : Integer; 45 | Prim : IPCB_Primitive; 46 | Prim2 : IPCB_Primitive; 47 | 48 | MLayerUsed : TStringList; 49 | MLIndex : integer; 50 | MechLayer : IPCB_MechanicalLayer; 51 | ML1 : integer; 52 | NewFPName : WideString; 53 | MLayerSet : IPCB_LayerSet; 54 | 55 | HowManyInt : Integer; 56 | intDialog : Integer; 57 | sStatusBar : WideString; 58 | iStatusBar : integer; 59 | TotPrims : integer; 60 | StartTime : TDateTime; 61 | StopTime : TDateTime; 62 | 63 | Begin 64 | CurrentLib := PCBServer.GetCurrentPCBLibrary; 65 | If CurrentLib = Nil Then 66 | Begin 67 | ShowMessage('This is not a PcbLib document'); 68 | Exit; 69 | End; 70 | 71 | // Verify user wants to continue, if cancel pressed, exit script. If OK, continue 72 | intDialog := MessageDlg('!!! Operation can NOT be undone, proceed with caution !!! ', mtWarning, mbOKCancel, 0); 73 | if intDialog = mrCancel then 74 | begin 75 | ShowMessage('Cancel pressed. Exiting '); 76 | Exit; 77 | end; 78 | 79 | GUIMan := Client.GUIManager; 80 | VerMajor := GetBuildNumberPart(Client.GetProductVersion, 0); 81 | 82 | MaxMechLayers := AD17MaxMechLayers; 83 | LegacyMLS := true; 84 | if VerMajor >= AD19VersionMajor then 85 | begin 86 | MaxMechLayers := AD19MaxMechLayers; 87 | LegacyMLS := false; 88 | end; 89 | 90 | Board := CurrentLib.Board; 91 | LayerStack := Board.MasterLayerStack; 92 | SComp := CurrentLib.GetState_CurrentComponent; 93 | if SComp = nil then exit; 94 | 95 | MLayerUsed := TStringList.Create; // mech layers used by current FP mechlayer prims. 96 | MLayerUsed.NameValueSeparator := '='; 97 | MLayerUsed.StrictDelimiter := true; 98 | 99 | FPList := TObjectList.Create; // hold a list of Comp Prims 100 | FPList.OwnsObjects := false; 101 | 102 | StartTime := Time; 103 | BeginHourGlass(crHourGlass); 104 | PCBServer.PreProcess; 105 | 106 | for i := 1 to MaxMechLayers do 107 | begin 108 | MechLayer := GetMechLayerObject(LayerStack, i, ML1); 109 | // UsedByPrims is property of current FP ! 110 | if MechLayer.UsedByPrims then 111 | MLayerUsed.Add(IntToStr(i) + '=' + IntToStr(ML1)); 112 | end; 113 | 114 | HowManyInt := 0; 115 | // approximate total low burden count. 116 | TotPrims := SComp.GetPrimitiveCount(AllObjects); 117 | 118 | for i := 0 to (MLayerUsed.Count -1) do 119 | begin 120 | MLIndex := MLayerUsed.Names(i); 121 | ML1 := MLayerUsed.ValueFromIndex(i); 122 | 123 | if (true) or MechLayer.MechanicalLayerEnabled then 124 | begin 125 | FPList.Clear; 126 | GIterator := SComp.GroupIterator_Create; 127 | // GIterator.AddFilter_IPCB_LayerSet(MLayerSet); /// dnw in group 128 | Prim := GIterator.FirstPCBObject; 129 | while Prim <> Nil Do 130 | begin 131 | if Prim.Layer = ML1 then 132 | FPList.Add(Prim); 133 | Prim := GIterator.NextPCBObject; 134 | end; 135 | SComp.GroupIterator_Destroy(GIterator); 136 | 137 | if FPList.Count > 0 then 138 | begin 139 | NewFPName := SComp.Name + '_MECHLAYER' + IntToStr(MLIndex); 140 | NewFP := CurrentLib.CreateNewComponent; 141 | NewFP.Name := CurrentLib.GetUniqueCompName(NewFPName); 142 | CurrentLib.RegisterComponent(NewFP); 143 | CurrentLib.SetState_CurrentComponent(NewFP); 144 | NewFP.BeginModify; 145 | end; 146 | 147 | for j := 0 to (FPList.Count -1) do 148 | begin 149 | Prim := FPList.Items(j); 150 | Prim2 := Prim.Replicate; 151 | SComp.RemovePCBObject(Prim); 152 | PCBServer.DestroyPCBObject(Prim); 153 | Board.AddPCBObject(Prim2); 154 | NewFP.AddPCBObject(Prim2); 155 | // this new CMP FP is focused so origin is different to source !! 156 | Prim2.MoveByXY(Board.XOrigin, Board.YOrigin); 157 | inc(HowManyInt); 158 | 159 | if (J MOD cStatusUpdate) = 0 then 160 | begin 161 | iStatusBar := Int(HowManyInt / ToTPrims * 100); 162 | sStatusBar := ' moving.. : ' + IntToStr(iStatusBar) + '% done'; 163 | GUIMan.StatusBar_SetState (1, sStatusBar); 164 | end; 165 | end; 166 | 167 | if FPList.Count > 0 then NewFP.EndModify; 168 | 169 | end; 170 | end; 171 | 172 | FPList.Clear; 173 | FPList.Destroy; 174 | MLayerUsed.Clear; 175 | PCBServer.PostProcess; 176 | 177 | // CurrentLib.Navigate_FirstComponent; 178 | CurrentLib.SetState_CurrentComponent(SComp); 179 | CurrentLib.Board.GraphicallyInvalidate; 180 | CurrentLib.Board.ViewManager_FullUpdate; 181 | CurrentLib.Board.GraphicalView_ZoomRedraw; 182 | CurrentLib.RefreshView; 183 | EndHourGlass; 184 | StopTime := Time; 185 | 186 | if HowManyInt > 0 then CurrentLib.Board.SetState_DocumentHasChanged; 187 | ShowMessage('Moved ' + IntToStr(HowManyInt) + ' mech layer primitives in '+ IntToStr((StopTime-StartTime)*24*3600) +' sec '); 188 | End; 189 | {..............................................................................} 190 | function GetMechLayerObject(LS: IPCB_MasterLayerStack, const i : integer, var MLID : TLayer) : IPCB_MechanicalLayer; 191 | begin 192 | if (LegacyMLS) then 193 | begin 194 | MLID := LayerUtils.MechanicalLayer(i); 195 | Result := LS.LayerObject_V7(MLID) 196 | end else 197 | begin 198 | Result := LS.GetMechanicalLayer(i); 199 | MLID := Result.V7_LayerID.ID; // .LayerID stops working at i=16 200 | end; 201 | end; 202 | 203 | 204 | -------------------------------------------------------------------------------- /Project/OutJob/RunOutJobDocs.pas: -------------------------------------------------------------------------------- 1 | { RunOutJobDocs.pas 2 | (from OJ-Dump.pas) 3 | runs all OutJobs in project 4 | runs the Containers (OutputMedium) that have connected Outputers. 5 | 6 | Author : BL Miller 7 | The Server Process Parameters mostly derived from Kevin Benstead 8 | see https://forum.live.altium.com/#/posts/258115/832922 9 | 10 | 2024-06-05 v0.10 POC 11 | 12 | } 13 | 14 | const 15 | bOpenReport = true; 16 | var 17 | Rpt : TStringList; 18 | 19 | function ProcessOJDoc(OJDoc : TJobManagerDocument) : integer; forward; 20 | 21 | Procedure Command_RunOutputJobs; 22 | Var 23 | WorkSpace : IWorkspace; 24 | Project : IProject; 25 | FilePath : String; 26 | ProjectDoc : IDocument; 27 | ServerDoc : IServerDocument; 28 | i : Integer; 29 | 30 | Begin 31 | WorkSpace := GetWorkspace; 32 | If WorkSpace = Nil then Exit; 33 | Project := WorkSpace.DM_FocusedProject; 34 | If Project = Nil Then Exit; 35 | 36 | If Project.DM_NeedsCompile Then 37 | Project.DM_Compile; 38 | 39 | Rpt := TStringList.Create; 40 | 41 | For i := 0 To (Project.DM_LogicalDocumentCount - 1) Do 42 | Begin 43 | ProjectDoc := Project.DM_LogicalDocuments(i); 44 | 45 | If ProjectDoc.DM_DocumentKind = cDocKind_OutputJob Then 46 | Begin 47 | FilePath := ProjectDoc.DM_FullPath; 48 | ServerDoc := Client.OpenDocument(cDocKind_OutputJob, FilePath); 49 | If ServerDoc = Nil Then continue; 50 | 51 | Rpt.Add(FilePath); 52 | Client.ShowDocument(ServerDoc); 53 | ProcessOJDoc(ServerDoc); 54 | End; 55 | End; 56 | 57 | FilePath := SpecialFolder_TemporarySlash + 'RunOJDocsReport1.txt'; 58 | Rpt.SaveToFile(FilePath); 59 | Rpt.Free; 60 | 61 | if bOpenReport then 62 | begin 63 | ServerDoc := Client.OpenDocument('Text', FilePath); 64 | If (ServerDoc <> Nil) Then 65 | begin 66 | Client.ShowDocument(ServerDoc); 67 | if (ServerDoc.GetIsShown <> 0 ) then 68 | ServerDoc.DoFileLoad; 69 | end; 70 | end; 71 | End; 72 | 73 | // TJobManagerDocument; IWSM_OutputJobDocument; 74 | function ProcessOJDoc(OJDoc : TJobManagerDocument) : integer; 75 | var 76 | OJContainer : IOutputMedium; 77 | Output : IOutputer; 78 | i, j : Integer; 79 | Process : String; 80 | Parameters : Widestring; 81 | OutCount : integer; 82 | 83 | begin 84 | Result := OJDoc.OutputMediumCount; 85 | 86 | For i := 0 to (Result - 1) Do 87 | Begin 88 | OJContainer := OJDoc.OutputMedium(i); 89 | 90 | OutCount := OJDoc.MediumOutputersCount(OJContainer); 91 | if OutCount < 1 then 92 | begin 93 | Rpt.Add('No Outputers connected to Container ' + OJContainer.Name + ' Type: ' + OJContainer.TypeString); 94 | Rpt.Add(''); 95 | continue; 96 | end; 97 | 98 | Rpt.Add('Running container ' + OJContainer.Name + ' Type: ' + OJContainer.TypeString + ' Path: ' + OJContainer.Outputpath); 99 | for j := 0 to (OutCount - 1) do 100 | begin 101 | Output := OJDoc.MediumOutputer(OJContainer, j); 102 | Rpt.Add(' ' + IntToStr(j+1) + ' for Outputer ' + Output.DM_GeneratorName + ' var: ' + OutPut.VariantName); 103 | end; 104 | 105 | Case OJContainer.TypeString Of 106 | 'Generate Files' : // generate files e.g boms, gerbers etc 107 | Begin 108 | ResetParameters; 109 | AddStringParameter ('Action', 'Run'); 110 | AddStringParameter ('ObjectKind', 'OutputBatch'); 111 | AddStringParameter ('OutputMedium', OJContainer.Name); 112 | AddStringParameter ('DisableDialog', 'True'); 113 | RunProcess('WorkspaceManager:GenerateReport'); 114 | Rpt.Add(OJContainer.Name + ' generated'); 115 | End; 116 | 'PDF' : // generate PDF files e.g schematics, assembly drawings etc 117 | Begin 118 | ResetParameters; 119 | AddStringParameter ('Action', 'PublishToPDF'); 120 | AddStringParameter ('ObjectKind', 'OutputBatch'); 121 | AddStringParameter ('OutputMedium', OJContainer.Name); 122 | AddStringParameter ('DisableDialog', 'True'); 123 | RunProcess('WorkspaceManager:Print'); 124 | Rpt.Add(OJContainer.Name + ' generated'); 125 | End; 126 | 'Print' : 127 | begin 128 | ResetParameters; 129 | // AddStringParameter ('Action', 'PrintDocument'); 130 | AddStringParameter ('Action', 'Preview'); 131 | AddStringParameter ('ObjectKind', 'OutputBatch'); 132 | AddStringParameter ('OutputMedium', OJContainer.Name); 133 | AddStringParameter ('DisableDialog', 'True'); 134 | RunProcess('WorkspaceManager:Print'); 135 | Rpt.Add(OJContainer.Name + ' generated'); 136 | end; 137 | Else 138 | Rpt.Add('Unknown Container Type of Name: ' + OJContainer.Name + ' Type: ' + OJContainer.TypeString); 139 | End; 140 | 141 | { 142 | alt syntax. 143 | Process := 'WorkspaceManager:Print'; 144 | Parameters := 'Action=PublishToPDF|DisableDialog=True|ObjectKind=OutputBatch'; 145 | // Parameters := 'Action=PublishMultimedia|DisableDialog=True|ObjectKind=OutputBatch'; 146 | 147 | Client.SendMessage(Process, Parameters, 256, Client.CurrentView); 148 | } 149 | Rpt.Add(''); 150 | End; 151 | end; 152 | 153 | -------------------------------------------------------------------------------- /Project/OutJob/dummy.txt: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /Project/PrjLibReLinker/PrjLibReLinker.pas: -------------------------------------------------------------------------------- 1 | { ProjectReLinker.pas 2 | 3 | A Wrapper for (requires) CompSourceLibReLinker.pas 4 | that iterates over all project files:- 5 | - 1. linking SchLibs to PcbLibs 6 | - 2. linking SchDocs to SchLib & SchImpl-models to PcbLib 7 | - 3. linking PcbDocs to PcbLib FP. 8 | - 4. make summary report 9 | 10 | 2 direct call entry points. Calls procedures in another script unit. 11 | 12 | Focus any project file (SchLib, SchDoc PcbDoc PcbLib) & will process 13 | in correct order to relink all components & comp models & footprints to Prj source libraries. 14 | 15 | BLM 16 | 11/05/2020 0.10 POC initial project wrapper 17 | 12/05/2020 0.11 unbreak the lib find method. 18 | 31/05/2020 0.12 support LibPkg projects; remove the installed lib reporting 19 | 05/05/2020 0.13 SerDoc methods to overcome Server open but not loaded & not updating serverview of doc. 20 | 2024-09-24 0.14 report totals at top of PrjPcb LibLinkSummary.txt 21 | 22 | Requires a project "holder" so procedures & functions can be found/shared. 23 | ..............................................................................} 24 | const 25 | ReportFileSuffix = '_LibLinkSummary'; 26 | ReportFileExtension = '.txt'; 27 | ReportFolder = 'Reports'; 28 | 29 | Var 30 | WS : IWorkspace; 31 | Prj : IProject; 32 | IntLibMan : IIntegratedLibraryManager; 33 | // Report : TStringList; 34 | Summary : TStringList; 35 | 36 | 37 | {..............................................................................} 38 | function SafeSaveDocument(Doc : IDocument, const ServerName : WideString) : boolean; 39 | var 40 | SM : IServerModule; 41 | ServerDoc : IServerDocument; 42 | J : Integer; 43 | 44 | begin 45 | Result := false; 46 | SM := Client.ServerModuleByName(ServerName); 47 | for J := 0 to (SM.DocumentCount - 1) do 48 | begin 49 | ServerDoc := SM.Documents[J]; 50 | if ExtractFilename(ServerDoc.FileName) = Doc.DM_Filename then 51 | begin 52 | Result := ServerDoc.DoSafeFileSave(Doc.DM_DocumentKind); // cDocKind_SchLib); 53 | end; 54 | end; 55 | end; 56 | 57 | function IterateTheDocs(DocKind : TDocumentKind, const Fix : Boolean, var TotSLinkCount, var TotFLinkCount : integer) : boolean; 58 | var 59 | Doc : IDocument; 60 | SerDoc : IServerDocument; 61 | SLinkCount : Integer; 62 | FLinkCount : Integer; 63 | I : Integer; 64 | bSuccess : boolean; 65 | 66 | Begin 67 | Result := false; 68 | 69 | For I := 0 to (Prj.DM_LogicalDocumentCount - 1) Do 70 | Begin 71 | Doc := Prj.DM_LogicalDocuments(I); 72 | If Doc.DM_DocumentKind = DocKind Then 73 | Begin 74 | Summary.Add(''); 75 | Summary.Add(''); 76 | Summary.Add('=============== New Doc =============================='); 77 | Summary.Add(' Doc : ' + Doc.DM_FileName); 78 | Summary.Add(''); 79 | 80 | 81 | // SerDoc := Client.OpenDocument('Sch', Doc.DM_FullPath); 82 | SerDoc := Client.OpenDocumentShowOrHide(DocKind, Doc.DM_FullPath, true); //TPCBLibDocument or TSCH ?? 83 | if SerDoc <> nil then 84 | Client.ShowDocument(SerDoc); 85 | 86 | bSuccess := false; 87 | if (DocKind = cDocKind_SchLib) or (DocKind = cDocKind_Sch) then 88 | bSuccess := LinkSchCompsWrapped(Doc, Fix, SLinkCount, FLinkCount); 89 | 90 | if DocKind = cDocKind_Pcb then 91 | bSuccess := LinkFPModelsWrapped (Doc, Fix, SLinkCount, FLinkCount); 92 | 93 | if bSuccess then 94 | SerDoc.Modified := True; 95 | 96 | if (bSuccess and (DocKind = cDocKind_SchLib)) then 97 | begin 98 | bSuccess := SafeSaveDocument(Doc, 'SCH'); 99 | end; 100 | 101 | Summary.Add(' Sheet : ' + Doc.DM_FileName); 102 | Summary.Add('Sheet Missing Sch Symbol Link Count : ' + IntToStr(SLinkCount)); 103 | Summary.Add('Sheet Missing Footprint Link Count : ' + IntToStr(FLinkCount)); 104 | Summary.Add(' ************** End Doc ******************************* '); 105 | 106 | TotSLinkCount := TotSLinkCount + SLinkCount; 107 | TotFLinkCount := TotFLinkCount + FLinkCount; 108 | End; 109 | End; 110 | 111 | Result := true; 112 | end; 113 | 114 | 115 | Procedure ReportWrapper(const Fix : boolean); 116 | var 117 | FilePath : WideString; 118 | FileName : WideString; 119 | FileNumber : integer; 120 | FileNumStr : WideString; 121 | ReportDocument : IServerDocument; 122 | 123 | TotSLinkCount : Integer; // Total missing symbol link count 124 | TotFLinkCount : Integer; // Total missing footprint model link count 125 | SubTotSLinkCount : Integer; // Total missing symbol link count in same doc type 126 | SubTotFLinkCount : Integer; // Total missing footprint model link count in same doc typr 127 | LibCount : integer; 128 | SMess : WideString; 129 | I : integer; 130 | bSuccess : boolean; 131 | 132 | Begin 133 | Prj := GetWorkSpace.DM_FocusedProject; 134 | If Prj = Nil Then Exit; 135 | // board or LibPkg(IntLib) projects 136 | if not ((Prj.DM_ObjectKindString = 'PCB Project') or 137 | (Prj.DM_ObjectKindString = 'Integrated Library')) then 138 | begin 139 | ShowMessage('not a PCB or LibPkg project '); 140 | exit; 141 | end; 142 | 143 | IntLibMan := IntegratedLibraryManager; 144 | If IntLibMan = Nil Then Exit; 145 | if PCBServer = Nil then Client.StartServer('PCB'); 146 | if SchServer = Nil then Client.StartServer('SCH'); 147 | 148 | 149 | Summary := TStringList.Create; 150 | Summary.Add('Project Library Re-Linker'); 151 | Summary.Add(' Project: ' + Prj.DM_ProjectFileName); 152 | Summary.Add(''); 153 | 154 | TotSLinkCount :=0; 155 | TotFLinkCount :=0; 156 | SubTotSLinkCount :=0; 157 | SubTotFLinkCount :=0; 158 | 159 | bSuccess := IterateTheDocs(cDocKind_SchLib, Fix, SubTotSLinkCount, SubTotFLinkCount); 160 | if not bSuccess then 161 | begin 162 | ShowMessage('problem with SchLib(s) '); 163 | exit; 164 | end; 165 | Summary.Add('SubTot SchLib Missing Sch Symbol Link Count : ' + IntToStr(SubTotSLinkCount)); 166 | Summary.Add('SubTot SchLib Missing Footprint Link Count : ' + IntToStr(SubTotFLinkCount)); 167 | 168 | TotSLinkCount := TotSLinkCount + SubTotSLinkCount; 169 | TotFLinkCount := TotFLinkCount + SubTotFLinkCount; 170 | SubTotSLinkCount :=0; 171 | SubTotFLinkCount :=0; 172 | 173 | bSuccess := IterateTheDocs(cDocKind_Sch, Fix, SubTotSLinkCount, SubTotFLinkCount); 174 | if not bSuccess then 175 | begin 176 | ShowMessage('problem with SchDoc(s) '); 177 | exit; 178 | end; 179 | Summary.Add('SubTot SchDoc Missing Sch Symbol Link Count : ' + IntToStr(SubTotSLinkCount)); 180 | Summary.Add('SubTot SchDoc Missing Footprint Link Count : ' + IntToStr(SubTotFLinkCount)); 181 | 182 | TotSLinkCount := TotSLinkCount + SubTotSLinkCount; 183 | TotFLinkCount := TotFLinkCount + SubTotFLinkCount; 184 | SubTotSLinkCount :=0; 185 | SubTotFLinkCount :=0; 186 | 187 | bSuccess := IterateTheDocs(cDocKind_Pcb, Fix, SubTotSLinkCount, SubTotFLinkCount); 188 | Summary.Add(''); 189 | Summary.Add(''); 190 | if not bSuccess then 191 | begin 192 | ShowMessage('problem with PcbDoc(s) '); 193 | end; 194 | Summary.Add('SubTot PcbDoc Missing Footprint Link Count : ' + IntToStr(SubTotFLinkCount)); 195 | 196 | TotFLinkCount := TotFLinkCount + SubTotFLinkCount; 197 | 198 | Summary.Insert(4, 'Total Missing Sch Symbol Link Count : ' + IntToStr(TotSLinkCount)); 199 | Summary.Insert(5, 'Total Missing Footprint Link Count : ' + IntToStr(TotFLinkCount)); 200 | Summary.Add('=========== EOF =================================='); 201 | 202 | FilePath := Prj.DM_ProjectFullPath; 203 | FileName := ExtractFileName(FilePath) + '_' + ReportFileSuffix; 204 | FilePath := ExtractFilePath(FilePath) + ReportFolder; 205 | if not DirectoryExists(FilePath, false) then 206 | DirectoryCreate(FilePath); 207 | 208 | FileNumber := 1; 209 | FileNumStr := IntToStr(FileNumber); 210 | FilePath := FilePath + '\' + FileName; 211 | While FileExists(FilePath + FileNumStr + ReportFileExtension) do 212 | begin 213 | inc(FileNumber); 214 | FileNumStr := IntToStr(FileNumber) 215 | end; 216 | FilePath := FilePath + FileNumStr + ReportFileExtension; 217 | Summary.SaveToFile(FilePath); 218 | 219 | ReportDocument := Client.OpenDocument('Text', FilePath); 220 | If ReportDocument <> Nil Then 221 | begin 222 | Client.ShowDocument(ReportDocument); 223 | if (ReportDocument.GetIsShown <> 0 ) then 224 | ReportDocument.DoFileLoad; 225 | end; 226 | End; 227 | 228 | Procedure FixCompLibraryLinks; 229 | Begin 230 | ReportWrapper(true) 231 | End; 232 | 233 | Procedure ReportCompLibraryLinks; 234 | begin 235 | ReportWrapper(false) 236 | end; 237 | 238 | 239 | -------------------------------------------------------------------------------- /Project/PrjLibReLinker/Readme.txt: -------------------------------------------------------------------------------- 1 | If you want to use One click project processing then: 2 | - make a script project to hold both .pas files. 3 | 4 | Can process LibPkg (IntLib) & board projects. 5 | 6 | CompSourceLibReLinker.pas 7 | These exposed procedure entry points are setup for single focused document action. 8 | - SchDoc/Lib relinking 9 | - PcbDoc FP relinking 10 | 11 | PrjLibReLinker.pas 12 | These exposed procedure entry points are setup to iterate over all project (board or LibPkg) documents 13 | in the sequence:- 14 | - SchLib, to link FPmodels to source PcbLib(s) 15 | - SchDoc, to link comps & comp models to source libs 16 | - PcbDoc, to link footprints to source PcbLib(s) 17 | 18 | All summary reports are created in subfolder "Reports" 19 | 20 | version AD19+ : 21 | Alternative DMObjects method as ISch_Implementation has issues 22 | Has to compile each Sheet. 23 | -------------------------------------------------------------------------------- /Project/UpdateSheetSymbolFN.pas: -------------------------------------------------------------------------------- 1 | { UpdateSheetSymbolFN.pas 2 | 3 | iterate active Prj sheets & find matching SheetSymbol source filenames. 4 | Replace source filename Old --> New 5 | 6 | POC: Sheet4.Schdoc --> Sheet5.SchDoc 7 | 8 | Author BL Miller 9 | 2024-05-27 0.10 POC. 10 | 2024-05-27 0.11 Open all Prj SchDocs with sheet symbols first 11 | 12 | } 13 | 14 | const 15 | OldSheetName = 'Sheet4.SchDoc'; 16 | 17 | procedure UpdateSheetSymbolFileName(SchematicDoc : IDocument, const FileNameUpdate : string); forward; 18 | 19 | var 20 | Prj : IProject; 21 | 22 | procedure main; 23 | var 24 | NewFileName : WideString; 25 | Doc : IDocument; 26 | ServDoc : IServerDocument; 27 | I : Integer; 28 | 29 | begin 30 | Prj := GetWorkSpace.DM_FocusedProject; 31 | If Prj = Nil Then Exit; 32 | 33 | NewFileName := 'Sheet5.SchDoc'; 34 | 35 | // Compile the project to fetch the connectivity information for the design. 36 | Prj.DM_Compile; 37 | 38 | // open all SchDoc with sheet symbols else ParentSheetSymbolCount is wrong! 39 | For I := 0 to (Prj.DM_LogicalDocumentCount - 1) Do 40 | Begin 41 | Doc := Prj.DM_LogicalDocuments(I); 42 | If Doc.DM_DocumentKind = cDocKind_Sch Then 43 | If Doc.DM_SheetSymbolCount > 0 Then 44 | Begin 45 | ServDoc := Client.OpenDocumentShowOrHide(cDocKind_Sch, Doc.DM_FullPath , True); 46 | Client.ShowDocument(ServDoc); 47 | End; 48 | End; 49 | 50 | For I := 0 to (Prj.DM_LogicalDocumentCount - 1) Do 51 | Begin 52 | Doc := Prj.DM_LogicalDocuments(I); 53 | If Doc.DM_DocumentKind = cDocKind_Sch Then 54 | Begin 55 | If Doc.DM_PartCount = 0 Then 56 | Begin 57 | ShowWarning('This SchDoc: ' + Doc.DM_FileName + ' has no components(Parts)'); 58 | // continue; 59 | End; 60 | 61 | if SameString(Doc.DM_FileName, OldSheetName, false) then 62 | UpdateSheetSymbolFileName(Doc, NewFileName); // not Path 63 | end; 64 | end; 65 | 66 | // rebuild project tree with new SSym file links. 67 | Prj.DM_Compile; 68 | end; 69 | 70 | procedure UpdateSheetSymbolFileName(SchematicDoc : IDocument, const FileNameUpdate : string); 71 | Var 72 | SchDocFilename : WideString; 73 | I,J,ParentSheetCount : Integer; 74 | FilePath : Widestring; 75 | Filename : WideString; 76 | ParentDoc : IDocument; 77 | ParentSheet : ISch_Document; 78 | DMOSheetSYM : ISheetSymbol; 79 | SheetSymbol : ISch_SheetSymbol; 80 | SSFN : ISch_SheetFileName; 81 | ParentIterator : ISch_Iterator; 82 | ParentSheetList : TStringList; 83 | 84 | Begin 85 | ParentSheetCount := SchematicDoc.DM_ParentSheetSymbolCount; 86 | SchDocFilename := SchematicDoc.DM_FileName; 87 | 88 | If (ParentSheetCount = 0) Then exit; 89 | 90 | ParentSheetList := TStringList.Create; 91 | For I := 0 To (ParentSheetCount - 1) Do 92 | begin 93 | DMOSheetSYM := SchematicDoc.DM_ParentSheetSymbols(I); 94 | FileName := DMOSheetSYM.DM_OwnerDocumentName; 95 | ParentSheetList.Add(FileName); 96 | end; 97 | 98 | For I := 0 To (ParentSheetList.Count - 1) Do 99 | Begin 100 | FileName := ParentSheetList[I]; 101 | FilePath := ExtractFilePath(Prj.DM_ProjectFullPath) + FileName; 102 | ParentDoc := Prj.DM_GetDocumentFromPath(FilePath); 103 | 104 | ParentSheet := SchServer.GetSchDocumentByPath(FilePath); 105 | if ParentSheet = Nil then 106 | ParentSheet := SchServer.LoadSchDocumentByPath(FilePath); 107 | If ParentSheet = Nil Then continue; 108 | 109 | SchServer.ProcessControl.PreProcess(ParentSheet, ''); 110 | 111 | ParentIterator := ParentSheet.SchIterator_Create; 112 | ParentIterator.AddFilter_ObjectSet(MkSet(eSheetSymbol)); 113 | SheetSymbol := ParentIterator.FirstSchObject; 114 | While SheetSymbol <> Nil Do 115 | Begin 116 | SSFN := SheetSymbol.GetState_SchSheetFileName; 117 | If (SchDocFilename = SSFN.Text) Then 118 | SSFN.SetState_Text(FileNameUpdate); 119 | 120 | SheetSymbol.GraphicallyInvalidate; 121 | SheetSymbol := ParentIterator.NextSchObject; 122 | End; 123 | 124 | ParentSheet.SchIterator_Destroy(ParentIterator); 125 | SchServer.ProcessControl.PostProcess(ParentSheet, ''); 126 | ParentDoc.DM_Compile; 127 | 128 | for J := 0 to (ParentDoc.DM_SheetSymbolCount - 1) do 129 | begin 130 | DMOSheetSYM := ParentDoc.DM_SheetSymbols(J); 131 | 132 | If (SchDocFilename = DMOSheetSYM.DM_SheetSymbolFileName) Then 133 | ShowWarning('new filename did not stick ! '); 134 | // DMOSheetSYM.DM_SheetSymbolFileName := FileNameUpdate; 135 | end; 136 | 137 | End; 138 | 139 | ParentSheetList.Free; 140 | SchematicDoc.DM_Compile; 141 | End; 142 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Altium-DelphiScripts 2 | Scripts for Altium Designer 17/18/19. 3 | 4 | #Project: 5 | Prj-Parameters.pas 6 | 7 | # PCB: 8 | See PCB folder.. 9 | 10 | #PcbLib: 11 | OutlineRegionsOnLayer.pas 12 | 13 | # OutJob: 14 | OutJob-Script / SimpleOJScript.pas 15 | > demo of OutJob run script interacting with OutJob interface (Configure, Change & Generate) 16 | 17 | #Sch: 18 | 19 | #SchLib: 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /Sch/RemoveSheetParameter.pas: -------------------------------------------------------------------------------- 1 | { RemoveSheetParameter.pas 2 | 3 | Can remove System parameters : need to save close & re-open SchDoc. 4 | 5 | Operates on Project logical documents of cDockind_Sch 6 | 7 | AD22.11 ?? AnnotateCompiled sheets (use of DeviceSheet??) add system para to each Sheet "SheetSymbolDesignator" 8 | This messes up the correct use & can NOIT be deleted without ascii file edit. 9 | 10 | BLM 11 | 20240202 v0.10 POC 12 | 20240330 v0.11 old AD17 missing better parameter fns. Check for non-project SchDoc. 13 | } 14 | const 15 | cBadParameter = 'SheetSymbolDesignator'; 16 | cLongBoolTrue = -1; 17 | cAD17 = 17; 18 | 19 | var 20 | Report : TStringList; 21 | VerMajor : integer; 22 | 23 | Function SchParameterGet(SGO : ISch_GraphicalObject, ParamName : String ) : ISch_Parameter; forward; 24 | Function RemoveSheetParameter(CurrentSch : ISch_Sheet, const ParamName : WideString) : boolean; forward; 25 | 26 | Procedure IterateTheSheets; 27 | var 28 | WS : IWorkspace; 29 | Prj : IProject; 30 | FilePath : WideString; 31 | FileName : WideString; 32 | ReportDocument : IServerDocument; 33 | Doc : IDocument; 34 | SerDoc : IServerDocument; 35 | CurrentSch : ISch_Document; 36 | I : Integer; 37 | SMess : WideString; 38 | bRemoved : boolean; 39 | bPrjChange : boolean; 40 | 41 | Begin 42 | WS := GetWorkspace; 43 | If WS = Nil Then Exit; 44 | 45 | Prj := WS.DM_FocusedProject; 46 | If Prj = Nil Then Exit; 47 | 48 | VerMajor := GetBuildNumberPart(Client.GetProductVersion, 0); 49 | 50 | Report := TStringList.Create; 51 | Report.Add('Remove Bad Parameter from Prj SchDocs'); 52 | Report.Add(' bad para: ' + cBadParameter); 53 | Report.Add(''); 54 | Report.Add(' Project: ' + Prj.DM_ProjectFileName); 55 | Report.Add(''); 56 | FilePath := ExtractFilePath(Prj.DM_ProjectFullPath); 57 | bPrjChange := false; 58 | 59 | For I := 0 to (Prj.DM_LogicalDocumentCount - 1) Do 60 | Begin 61 | Doc := Prj.DM_LogicalDocuments(I); 62 | 63 | If Doc.DM_DocumentKind = cDocKind_Sch Then 64 | Begin 65 | CurrentSch := SchServer.GetSchDocumentByPath(Doc.DM_FullPath); 66 | // if you have not double clicked on Doc/file it is open but not loaded. 67 | If CurrentSch = Nil Then 68 | CurrentSch := SchServer.LoadSchDocumentByPath(Doc.DM_FullPath); 69 | 70 | If CurrentSch <> Nil Then 71 | Begin 72 | Report.Add(''); 73 | Report.Add('=== Sheet : ' + Doc.DM_FileName + ' ====='); 74 | Report.Add(''); 75 | 76 | bRemoved := RemoveSheetParameter(CurrentSch, cBadParameter); 77 | bPrjChange := bPrjChange or bRemoved; 78 | CurrentSch.GraphicallyInvalidate; 79 | 80 | if FilePath <> '' then 81 | if FilePath <> 'FreeDocuments' then 82 | begin 83 | SerDoc := Doc.DM_ServerDocument; 84 | if bRemoved then 85 | SerDoc.Modified := cLongBoolTrue; 86 | end; 87 | 88 | Report.Add(''); 89 | Report.Add(' ********** End Sheet ********************* '); 90 | 91 | End; 92 | End; 93 | End; 94 | 95 | if FilePath = '' then 96 | FilePath := ExtractFilePath(Doc.DM_FullPath); 97 | FileName := FilePath + '\RemoveSheetPara_Report.Txt'; 98 | Report.SaveToFile(FileName); 99 | 100 | if bPrjChange then 101 | ShowMessage('need to Save, Close the SchDoc.'); 102 | 103 | //Prj.DM_AddSourceDocument(FileName); 104 | ReportDocument := Client.OpenDocument('Text', FileName); 105 | If ReportDocument <> Nil Then 106 | Client.ShowDocument(ReportDocument); 107 | 108 | End; 109 | 110 | function RemoveSheetParameter(CurrentSch : ISch_Sheet, const ParamName : WideString) : boolean; 111 | Var 112 | Parameter : ISch_Parameter; 113 | Begin 114 | Result := False; 115 | 116 | if VerMajor > cAD17 then 117 | Parameter := CurrentSch.GetState_SchParameterByName(ParamName) 118 | else 119 | Parameter := SchParameterGet(CurrentSch, ParamName); 120 | 121 | if Parameter <> Nil Then 122 | Begin 123 | Result := True; 124 | Report.Add('IsSystemPara: ' + BoolToStr(Parameter.IsSystemParameter,true) + ' paraname: ' + Parameter.Name); 125 | if (Parameter.IsSystemParameter) then 126 | begin 127 | CurrentSch.RemoveSchObject( Parameter ); 128 | SchServer.DestroySchObject( Parameter ); 129 | end else 130 | CurrentSch.Remove_Parameter( Parameter ); 131 | End; 132 | end; 133 | 134 | Function SchParameterGet(SGO : ISch_GraphicalObject, ParamName : String ) : ISch_Parameter; 135 | Var 136 | PIterator : ISch_Iterator; 137 | Parameter : ISch_Parameter; 138 | Begin 139 | Result := Nil; 140 | 141 | PIterator := SGO.SchIterator_Create; 142 | PIterator.AddFilter_ObjectSet( MkSet( eParameter ) ); 143 | PIterator.SetState_IterationDepth(eIterateAllLevels); 144 | 145 | Parameter := PIterator.FirstSchObject; 146 | While Parameter <> Nil Do 147 | Begin 148 | If SameString( Parameter.Name, ParamName, False ) Then 149 | Begin 150 | Result := Parameter; 151 | Break; 152 | End; 153 | Parameter := PIterator.NextSchObject; 154 | End; 155 | SGO.SchIterator_Destroy( PIterator ); 156 | End; 157 | 158 | 159 | -------------------------------------------------------------------------------- /Sch/TogglePinVis.pas: -------------------------------------------------------------------------------- 1 | { SchDoc: Pins 2 | 3 | TogglePinVisibility(): 4 | Toggles visiblity of Pin designator (number) 5 | modifiers: 6 | toggles Pin name visibility. 7 | toggles rotation of Pin name ONLY works if Pin has Custom Position set! 8 | toggles all pins of the pin owner comp 9 | 10 | ToggleCompPinVisibility(): 11 | Toggle visibility of all pins of picked component 12 | toggles all pins of components with same library reference. 13 | 14 | BL Miller. 15 | 16 | if Comp.ShowHiddenPins is true then can not hide anything. 17 | 18 | ISch_Pin.Width // integer 19 | ISch_Pin.Name_CustomFontID; //TFontID 20 | ISch_Pin.Name_FontMode; // TPinItemMode 21 | ISch_Pin.Name_CustomColor; //TColor 22 | ISch_pin.Name_CustomPosition_Margin; //TCoord 23 | ISch_Pin.Name_CustomPosition_RotationAnchor; //TPinTextRotationAnchor 24 | ISch_Pin.Name_CustomPosition_RotationRelative; // TRotationBy90 25 | similar for Designator 26 | 27 | } 28 | // ScriptingSystem:RunScriptText 29 | // Text=Var S,L,H,P;Begin S:=SchServer.GetCurrentSchDocument;L:=EmptyLocation;S.ChooseLocationInteractively(L,'Pick a Pin ');H:=S.CreateHitTest(0,L);P:=H.HitObject(0);if P.ObjectID=ePin then P.SetState_ShowDesignator(true);end; 30 | // Text=Var S,L,H,P;Begin S:=SchServer.GetCurrentSchDocument;L:=EmptyLocation;S.ChooseLocationInteractively(L,'Pick a CMP ');H:=S.CreateHitTest(0,L);P:=H.HitObject(0);if P.ObjectID=eSchComponent then P.SetState_ShowHiddenPins:=false;end; 31 | 32 | var 33 | SchDoc : ISch_Document; 34 | 35 | procedure ProcessCompPins(SchDoc : ISch_Document, Comp : ISch_Component, const OnlyThisComp : boolean); forward; 36 | procedure ProcessPin(var Pin : ISch_Pin); forward; 37 | function GetCompPin(Comp : ISch_Component, Designator : Text) : ISch_Pin; forward; 38 | 39 | procedure TogglePinVisibility; 40 | var 41 | OwnerComp : ISch_Component; 42 | Hit : THitTestResult; 43 | HitState : boolean; 44 | Location : TLocation; 45 | I : integer; 46 | Obj : ISch_GraphicalObject; 47 | Pin : ISch_Pin; 48 | 49 | begin 50 | SchDoc := SchServer.GetCurrentSchDocument; 51 | Location := EmptyLocation; 52 | 53 | repeat 54 | HitState := SchDoc.ChooseLocationInteractively(Location,'Pick a Pin '); 55 | 56 | if not(HitState) then 57 | break; 58 | 59 | Hit := SchDoc.CreateHitTest(eHitTest_AllObjects, Location); 60 | // Cursor := HitTestResultToCursor(Hit); 61 | 62 | I := 0; 63 | while I < Hit.HitTestCount do 64 | begin 65 | Obj := Hit.HitObject(I); 66 | 67 | if (Obj.ObjectId = ePin) then 68 | begin 69 | Pin := Obj; 70 | OwnerComp := Pin.OwnerSchComponent; 71 | 72 | if AltKeyDown then 73 | ProcessCompPins(SchDoc, OwnerComp, true) 74 | else 75 | ProcessPin(Pin); 76 | 77 | end; 78 | inc(I); 79 | end; 80 | until not (HitState) 81 | end; 82 | 83 | procedure ToggleCompPinVis; 84 | var 85 | SchDoc : ISch_Document; 86 | Hit : THitTestResult; 87 | HitState : boolean; 88 | Location : TLocation; 89 | I : integer; 90 | Obj : ISch_GraphicalObject; 91 | 92 | begin 93 | SchDoc := SchServer.GetCurrentSchDocument; 94 | Location := EmptyLocation; 95 | 96 | repeat 97 | HitState := SchDoc.ChooseLocationInteractively(Location,'Pick a Component '); 98 | 99 | if not(HitState) then 100 | break; 101 | 102 | Hit := SchDoc.CreateHitTest(eHitTest_AllObjects, Location); 103 | // Cursor := HitTestResultToCursor(Hit); 104 | 105 | I := 0; 106 | while I < Hit.HitTestCount do 107 | begin 108 | Obj := Hit.HitObject(I); 109 | 110 | if (Obj.ObjectId = eSchComponent) then 111 | begin 112 | Obj.ShowHiddenPins := true; 113 | Obj.ShowHiddenFields := true; 114 | Obj.ShowHiddenPins := false; 115 | Obj.ShowHiddenFields := false; 116 | Obj.GraphicallyInvalidate; 117 | ProcessCompPins(SchDoc, Obj, false); 118 | end; 119 | inc(I); 120 | end; 121 | until not (HitState) 122 | end; 123 | 124 | procedure ProcessCompPins(SchDoc : ISch_Document, Comp : ISch_Component, const OnlyThisComp : boolean); 125 | var 126 | OwnerComp : ISch_Component; 127 | CompLibRef : WideString; 128 | Pin : ISch_Pin; 129 | PinIterator : ISch_Iterator; 130 | Change : boolean; 131 | 132 | begin 133 | PinIterator := SchDoc.SchIterator_Create; // was CurrentSheet 134 | PinIterator.AddFilter_ObjectSet(MkSet(ePin)); 135 | 136 | Pin := PinIterator.FirstSchObject; 137 | while Pin <> Nil Do 138 | begin 139 | Change := false; 140 | OwnerComp := Pin.OwnerSchComponent; 141 | 142 | if (Not OnlyThisComp) and AltKeyDown then 143 | if (Comp.LibReference <> '') then 144 | if SameString(OwnerComp.LibReference, Comp.LibReference,true) then 145 | Change := true; 146 | 147 | if SameString(OwnerComp.UniqueId, Comp.UniqueId, false) then 148 | Change := true; 149 | 150 | if (Change) then 151 | ProcessPin(Pin); 152 | 153 | Pin := PinIterator.NextSchObject; 154 | end; 155 | SchDoc.SchIterator_Destroy(PinIterator); 156 | end; 157 | 158 | procedure ProcessPin(var Pin : ISch_Pin); 159 | begin 160 | 161 | if Pin.IsHidden then 162 | Pin.SetState_IsHidden( false); 163 | if Pin.Disabled then 164 | Pin.SetState_Disabled(false); 165 | if not(ShiftKeyDown) then 166 | begin 167 | if not (ControlKeyDown) then 168 | begin 169 | if (Pin.ShowDesignator) then 170 | Pin.SetState_ShowDesignator(false) 171 | else 172 | Pin.SetState_ShowDesignator(true); 173 | 174 | end else 175 | begin 176 | if (Pin.GetState_ShowName) then 177 | Pin.SetState_ShowName(false) 178 | else 179 | Pin.SetState_ShowName(true); 180 | 181 | end; 182 | end else 183 | begin 184 | // down this used to work ?? 185 | if (Pin.Name_CustomPosition_RotationRelative = 0) then 186 | Pin.SetState_Name_CustomPosition_RotationRelative(1) // := 1 187 | else 188 | Pin.SetState_Name_CustomPosition_RotationRelative(0); 189 | end; 190 | Pin.GraphicallyInvalidate; 191 | end; 192 | 193 | function GetCompPin(Comp : ISch_Component, Designator : Text) : ISch_Pin; 194 | var 195 | Pin : ISch_Pin; 196 | PinIterator : ISch_Iterator; 197 | begin 198 | Result := nil; 199 | PinIterator := Comp.SchIterator_Create; 200 | PinIterator.AddFilter_ObjectSet(MkSet(ePin)); 201 | 202 | Pin := PinIterator.FirstSchObject; 203 | while Pin <> Nil Do 204 | begin 205 | if Pin.Designator = Designator then 206 | begin 207 | Result := Pin; 208 | break; 209 | end; 210 | Pin := PinIterator.NextSchObject; 211 | end; 212 | Comp.SchIterator_Destroy(PinIterator); 213 | end; 214 | -------------------------------------------------------------------------------- /SchLib/CompRename2.pas: -------------------------------------------------------------------------------- 1 | {............................................................................. 2 | CompRename2.pas SchLib or SchDoc 3 | rename component using the "Comment" parameter text. 4 | Check for a unique name in SchLib is made.. 5 | Breaks the component (symbol) vault connection to allow renaming 6 | 7 | Saves the original comp name to component parameter: "cCompNameParameter" 8 | Maybe useful for components from A365 (Vault) that originated in local file based libraries.. 9 | 10 | Does NOT remove the Model vault links. 11 | 12 | see Sch/CompVaultState.pas for disconnecting Comp & FP models from vault. 13 | 14 | from Altium Summary Demo how to iterate through a schematic library. 15 | 16 | 17 | Author BL Miller 18 | 02/09/2021 v1.0 POC 19 | 08/08/2022 v1.1 minor tweak around changing parameter. 20 | 09/08/2022 v1.11 support SchDoc & break comp symbol vault link 21 | 22 | Note: current focused component (in SchLib) can NOT have its designator properties changed 23 | using Comp.Designator method. MUST use ISch_Parameter 24 | Maybe try .SetState_Designator('text') 25 | 26 | ..............................................................................} 27 | const 28 | cCompNameParameter = 'A365_CompLibName'; 29 | 30 | {..............................................................................} 31 | var 32 | Document : IDocument; 33 | CurrentLib : ISch_Lib; 34 | IsLib : boolean; 35 | 36 | Function SchParameterFind( Component : ISch_Component, ParamName : String ) : ISch_Parameter; forward; 37 | Function SchParameterAdd( Component : ISch_Component, ParamName : String, Value : String ) : Boolean; forward; 38 | Function SchParameterSet( Component : ISch_Component, ParamName : String, Value : String ) : Boolean; forward; 39 | function CheckLibCompName(SchLib : ISch_Lib, const CompName : WideString) : WideString; forward; 40 | Procedure GenerateReport(Report : TStringList); forward; 41 | {..............................................................................} 42 | 43 | {..............................................................................} 44 | Procedure ReNameSchLibPartWithComment; 45 | Var 46 | LibraryIterator : ISch_Iterator; 47 | Designator : ISch_Designator; 48 | i, j : integer; 49 | LibComp : ISch_Component; 50 | ReportInfo : TStringList; 51 | CompName : TString; 52 | DesignItemId : WideString; 53 | NewCompName : TString; 54 | Comment : TString; 55 | NameSuffix : WideString; 56 | 57 | Begin 58 | If SchServer = Nil Then Exit; 59 | 60 | CurrentLib := SchServer.GetCurrentSchDocument; 61 | If CurrentLib = Nil Then Exit; 62 | 63 | if not ((CurrentLib.ObjectID = eSheet) or (CurrentLib.ObjectID = eSchLib)) Then 64 | begin 65 | ShowMessage('No SchDoc or SchLib selected. '); 66 | Exit; 67 | end; 68 | IsLib := false; 69 | if (CurrentLib.ObjectID = eSchLib) then 70 | IsLib := true; 71 | 72 | // Create a TStringList object to store data 73 | ReportInfo := TStringList.Create; 74 | ReportInfo.Add(''); 75 | 76 | i := 1; j := 0; 77 | 78 | if IsLib then 79 | LibraryIterator := CurrentLib.SchLibIterator_Create 80 | else 81 | LibraryIterator := CurrentLib.SchIterator_Create; 82 | LibraryIterator.AddFilter_ObjectSet(MkSet(eSchComponent)); 83 | 84 | LibComp := LibraryIterator.FirstSchObject; 85 | While LibComp <> Nil Do 86 | Begin 87 | DesignItemId := Libcomp.DesignItemId; 88 | CompName := DesignItemId; 89 | if (IsLib) then 90 | CompName := LibComp.LibReference; 91 | 92 | Designator := LibComp.GetState_SchDesignator; 93 | Comment := LibComp.Comment.Text; 94 | 95 | // if from Vault then must break to rename. 96 | if LibComp.VaultGUID <> '' then 97 | begin 98 | LibComp.SetState_VaultGUID(''); 99 | LibComp.Setstate_SourceLibraryName(''); 100 | LibComp.UseLibraryName := false; 101 | end; 102 | 103 | // backup the exisitng Name as a parameter 104 | SchParameterSet( LibComp, cCompNameParameter, CompName ); 105 | 106 | NewCompName := CompName; 107 | 108 | // rename compoment with Comment 109 | // blank comments are useless 110 | if Comment <> '' then 111 | NewCompName := Comment; 112 | 113 | // check new name is unique in SchLib 114 | NameSuffix := ''; 115 | if IsLib then 116 | begin 117 | NewCompName := CheckLibCompName(CurrentLib, NewCompName); 118 | end; 119 | 120 | if (NewCompName <> CompName) then 121 | begin 122 | LibComp.UpdatePart_PreProcess; 123 | LibComp.SetState_LibReference(NewCompName); 124 | LibComp.SetState_DesignItemId(NewCompName); 125 | LibComp.UpdatePart_PostProcess; 126 | 127 | ReportInfo.Add(PadRight(IntToStr(i),3) + ' Existing Name, Ref.Des and Comment : ' + CompName + ' | ' + Designator.Text + ' | ' + Comment + ' New Name : ' + LibComp.LibReference ); 128 | end 129 | else 130 | ReportInfo.Add(PadRight(IntToStr(i),3) + ' Existing Name, Ref.Des and Comment : ' + CompName + ' | ' + Designator.Text + ' | ' + Comment + ' NO Name change '); 131 | 132 | inc(i); 133 | LibComp := LibraryIterator.NextSchObject; 134 | End; 135 | 136 | LibComp := LibraryIterator.FirstSchObject; 137 | 138 | CurrentLib.SchIterator_Destroy(LibraryIterator); 139 | 140 | CurrentLib.GraphicallyInvalidate; 141 | // Set the document dirty. 142 | Client.GetCurrentView.OwnerDocument.Modified := True; 143 | 144 | if IsLib then 145 | CurrentLib.UpdateDisplayForCurrentSheet; 146 | 147 | GenerateReport(ReportInfo); 148 | ReportInfo.Free; 149 | End; 150 | {..............................................................................} 151 | function CheckLibCompName(SchLib : ISch_Lib, const CompName : WideString) : WideString; 152 | var 153 | CompLoc : WideString; 154 | NewCompName : Widestring; 155 | Iterator : ISch_Iterator; 156 | Comp : ISch_Component; 157 | found : boolean; 158 | Cnt : integer; 159 | begin 160 | Result := CompName; 161 | Cnt := 1; 162 | NewCompName := CompName; 163 | 164 | repeat 165 | found := false; 166 | 167 | if SchLib.GetState_SchComponentByLibRef(NewCompName) <> nil then 168 | found := true; 169 | if found then 170 | NewCompName := CompName + '_' + IntToStr(Cnt); // IncrementStringasText('a_1', '1'); 171 | 172 | inc(Cnt); 173 | until (Cnt > 10) or (not found); 174 | 175 | Result := NewCompName; 176 | end; 177 | 178 | Procedure GenerateReport(Report : TStringList); 179 | Var 180 | Document : IServerDocument; 181 | Begin 182 | Report.Insert(0,'Schematic Library Part (Re)Name Report ' + CurrentLib.DocumentName); 183 | Report.Insert(1,'------------------------------'); 184 | 185 | { 186 | FileName := Doc.DM_FileName + '_' + ReportFileSuffix; 187 | FilePath := ExtractFilePath(FilePath) + ReportFolder; 188 | if not DirectoryExists(FilePath, false) then 189 | DirectoryCreate(FilePath); 190 | 191 | FileNumber := 1; 192 | FileNumStr := IntToStr(FileNumber); 193 | FilePath := FilePath + '\' + FileName; 194 | While FileExists(FilePath + FileNumStr + ReportFileExtension) do 195 | begin 196 | inc(FileNumber); 197 | FileNumStr := IntToStr(FileNumber) 198 | end; 199 | FilePath := FilePath + FileNumStr + ReportFileExtension; 200 | Report.SaveToFile(FilePath); 201 | } 202 | 203 | Report.SaveToFile('C:\temp\LibraryPartNameReport.txt'); 204 | 205 | Document := Client.OpenDocument('Text','C:\temp\LibraryPartNameReport.txt'); 206 | If Document <> Nil Then 207 | begin 208 | Client.ShowDocument(Document); 209 | if (Document.GetIsShown <> 0 ) then 210 | Document.DoFileLoad; 211 | end; 212 | 213 | End; 214 | {..............................................................................} 215 | Function SchParameterFind( Component : ISch_Component, ParamName : String ) : ISch_Parameter; 216 | Var 217 | PIterator : ISch_Iterator; 218 | Parameter : ISch_Parameter; 219 | Begin 220 | Result := Nil; 221 | Try 222 | // Go through list of parameters 223 | PIterator := Component.SchIterator_Create; 224 | PIterator.AddFilter_ObjectSet( MkSet( eParameter ) ); 225 | 226 | Parameter := PIterator.FirstSchObject; 227 | While Parameter <> Nil Do 228 | Begin 229 | If SameString( Parameter.Name, ParamName, False ) Then 230 | Begin 231 | Result := Parameter; 232 | Break; 233 | End; 234 | Parameter := PIterator.NextSchObject; 235 | End; 236 | Finally 237 | Component.SchIterator_Destroy( PIterator ); 238 | End; 239 | End; 240 | {..............................................................................} 241 | // this should work for SchLib & SchDoc. 242 | Function SchParameterAdd( Component : ISch_Component, ParamName : String, Value : String ) : Boolean; 243 | Var 244 | Parameter : ISch_Parameter; 245 | 246 | Begin 247 | Result := False; 248 | 249 | // Parameter := SchServer.SchObjectFactory( eParameter, eCreate_Default ); 250 | Component.UpdatePart_PreProcess; 251 | 252 | Parameter := Component.AddSchParameter; 253 | Parameter.Name := ParamName; 254 | Parameter.SetState_Text(Value); 255 | Parameter.OwnerPartId := Component.CurrentPartID; 256 | Parameter.OwnerPartDisplayMode := Component.DisplayMode; 257 | 258 | if (not IsLib) then 259 | begin 260 | // Component.AddSchObject( Parameter ); 261 | SchServer.RobotManager.SendMessage( Component.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, Parameter.I_ObjectAddress ); 262 | end; 263 | Component.UpdatePart_PostProcess; 264 | 265 | Result := True; 266 | End; 267 | 268 | Function SchParameterSet( Component : ISch_Component, ParamName : String, Value : String ) : Boolean; 269 | Var 270 | Parameter : ISch_Parameter; 271 | Begin 272 | Result := False; 273 | Parameter := SchParameterFind( Component, ParamName ); 274 | if Parameter <> Nil Then 275 | begin 276 | Component.UpdatePart_PreProcess; 277 | // SchServer.RobotManager.SendMessage( Parameter.I_ObjectAddress, c_BroadCast, SCHM_BeginModify, c_NoEventData ); 278 | Parameter.SetState_Text(Value); 279 | Parameter.OwnerPartId := Component.CurrentPartID; 280 | Parameter.OwnerPartDisplayMode := Component.DisplayMode; 281 | Component.UpdatePart_PostProcess; 282 | // SchServer.RobotManager.SendMessage( Parameter.I_ObjectAddress, c_BroadCast, SCHM_EndModify, c_NoEventData ); 283 | Result := True; 284 | end else 285 | begin 286 | Result := SchParameterAdd( Component, ParamName, Value ); 287 | end; 288 | if Parameter <> Nil Then 289 | begin 290 | Parameter.ShowName := False; 291 | Parameter.IsHidden := false; 292 | Component.SetState_xSizeySize; 293 | Component.GraphicallyInvalidate; 294 | end; 295 | End; 296 | {..............................................................................} 297 | -------------------------------------------------------------------------------- /SchLib/CountSymbolPins.pas: -------------------------------------------------------------------------------- 1 | {............................................................................. 2 | CountSymbolPins.pas 3 | SchLib & SchDoc 4 | Count pins of all parts of Symbols 5 | Report part cnt & pin xy & len 6 | 7 | Disabled --> Save as parameter to allow use by FSO/Inspector 8 | 9 | from Altium Summary Demo how to iterate through a schematic library. 10 | 11 | Version 1.0 12 | BL Miller 13 | 17/04/2020 v1.10 added pin x, y & len 14 | 04/03/2021 v1.20 added all parts & modes & support SchDoc 15 | 16/04/2021 v1.21 improved multi-part designator 16 | ..............................................................................} 17 | 18 | const 19 | bDisplay = true; 20 | bAddParameter = false; 21 | 22 | Procedure GenerateReport(Report : TStringList, Filename : WideString); 23 | Var 24 | WS : IWorkspace; 25 | Prj : IProject; 26 | Document : IServerDocument; 27 | Filepath : WideString; 28 | 29 | Begin 30 | WS := GetWorkspace; 31 | If WS <> Nil Then 32 | begin 33 | Prj := WS.DM_FocusedProject; 34 | If Prj <> Nil Then 35 | Filepath := ExtractFilePath(Prj.DM_ProjectFullPath); 36 | end; 37 | 38 | If length(Filepath) < 5 then Filepath := 'c:\temp\'; 39 | 40 | Filepath := Filepath + Filename; 41 | 42 | Report.SaveToFile(Filepath); 43 | 44 | Document := Client.OpenDocument('Text',Filepath); 45 | if bDisplay and (Document <> Nil) Then 46 | begin 47 | Client.ShowDocument(Document); 48 | if (Document.GetIsShown <> 0 ) then 49 | Document.DoFileLoad; 50 | end; 51 | End; 52 | 53 | {..............................................................................} 54 | Procedure LoadPinCountParameter; 55 | Const 56 | SymbolPinCount = 'SymbolPinCount'; //parameter name. 57 | 58 | Var 59 | CurrentLib : ISch_Lib; 60 | LibIterator : ISch_Iterator; 61 | Iterator : ISch_Iterator; 62 | Units : TUnits; 63 | UnitsSys : TUnitSystem; 64 | AnIndex : Integer; 65 | i : integer; 66 | LibComp : ISch_Component; 67 | Item : ISch_Line; 68 | OldItem : ISch_Line; 69 | Pin : ISch_Pin; 70 | ReportInfo : TStringList; 71 | CompName : TString; 72 | CompDesg : WideString; 73 | PinCount : Integer; 74 | 75 | PartCount : Integer; // sub parts (multi-gate) of 1 component 76 | DMCount : integer; 77 | PrevPID : Integer; 78 | ThisPID : Integer; 79 | ThisDMode : TDisplayMode; 80 | 81 | LocX, LocY : TCoord; 82 | PDes : WideString; 83 | PName : WideString; 84 | PLength : TCoord; 85 | 86 | Begin 87 | If SchServer = Nil Then Exit; 88 | CurrentLib := SchServer.GetCurrentSchDocument; 89 | If CurrentLib = Nil Then Exit; 90 | 91 | If (CurrentLib.ObjectID <> eSchLib) and (CurrentLib.ObjectID <> eSheet) Then 92 | Begin 93 | ShowError('Please open a schematic doc or library.'); 94 | Exit; 95 | End; 96 | 97 | Units := GetCurrentDocumentUnit; 98 | UnitsSys := GetCurrentDocumentUnitSystem; 99 | ReportInfo := TStringList.Create; 100 | 101 | if CurrentLib.ObjectID = eSchLib Then 102 | LibIterator := CurrentLib.SchLibIterator_Create 103 | else 104 | LibIterator := CurrentLib.SchIterator_Create; 105 | 106 | LibIterator.AddFilter_ObjectSet(MkSet(eSchComponent)); 107 | 108 | // find the aliases for the current library component. 109 | LibComp := LibIterator.FirstSchObject; 110 | While LibComp <> Nil Do 111 | Begin 112 | CompName := LibComp.LibReference; 113 | CompDesg := LibComp.Designator.Text; 114 | // if CurrentLib.ObjectID = eSheet then 115 | // CompDesg := LibComp.FullPartDesignator(LibComp.CurrentPartID); 116 | 117 | ReportInfo.Add('Comp Name: ' + CompName + ' | Des : ' + CompDesg); 118 | PartCount := LibComp.PartCount; 119 | 120 | LibComp.GetState_PartCountNoPart0; 121 | 122 | ThisPID := LibComp.CurrentPartID; 123 | ThisDMode := LibComp.DisplayMode; 124 | DMCount := LibComp.DisplayModeCount; 125 | ReportInfo.Add('Number parts : ' + IntToStr(PartCount) + ' | CurrentPartID : ' + IntToStr(ThisPID) + ' | modes cruft : ' + IntToStr(DMCount) + ' | Current Mode : ' + IntToStr(ThisDMode)); 126 | 127 | LibComp.IsMultiPartComponent; 128 | 129 | Iterator := LibComp.SchIterator_Create; 130 | Iterator.AddFilter_ObjectSet(MkSet(ePin)); 131 | 132 | // Part0 is some global power pin graphic nonsense 133 | for i := 1 to (PartCount) do 134 | begin 135 | ReportInfo.Add('PartID : ' + IntToStr(i) + ' ' + LibComp.FullPartDesignator(i) ); 136 | ReportInfo.Add('Pin Name Mode X Y length '); 137 | 138 | PinCount := 0; 139 | 140 | Item := Iterator.FirstSchObject; 141 | while Item <> Nil Do 142 | begin 143 | ThisDMode :=Item.OwnerPartDisplayMode; 144 | ThisPID := Item.OwnerPartId; 145 | 146 | if i = ThisPID then 147 | begin 148 | 149 | If Item.ObjectID = ePin Then 150 | Begin 151 | Pin := Item; 152 | PDes := Pin.Designator; 153 | PName := Pin.Name; 154 | PLength := Pin.PinLength; 155 | LocX := Pin.Location.X; 156 | LocY := Pin.Location.Y; 157 | // CoordUnitToStringNoUnit(L1.x, Units) 158 | 159 | ReportInfo.Add(PadRight(PDes,4) + PadRight(PName,6) + PadRight(IntToStr(ThisDMode),2) + ' ' + CoordUnitToStringWithAccuracy(LocX, Units, 5, 10) + ' ' + CoordUnitToStringwithAccuracy(LocY, Units, 5, 10) + ' '+ CoordUnitToStringWithAccuracy(PLength, Units, 5, 10)); 160 | Inc(PinCount); 161 | end; 162 | End; 163 | Item := Iterator.NextSchObject; 164 | 165 | end; 166 | ReportInfo.Add(' Pin Count : ' + IntToStr(PinCount)); 167 | end; 168 | 169 | LibComp.SchIterator_Destroy(Iterator); 170 | ReportInfo.Add(''); 171 | LibComp := LibIterator.NextSchObject; 172 | End; 173 | 174 | 175 | If CurrentLib.ObjectID = eSchLib Then 176 | // CurrentLib.SchLibIterator_Destroy(Iterator) 177 | CurrentLib.SchIterator_Destroy(Iterator) 178 | Else 179 | CurrentLib.SchIterator_Destroy(Iterator); 180 | 181 | CurrentLib.GraphicallyInvalidate; 182 | CurrentLib.OwnerDocument.UpdateDisplayForCurrentSheet; 183 | 184 | 185 | ReportInfo.Insert(0,'SchLib Part Pin Count Report'); 186 | ReportInfo.Insert(1,'------------------------------'); 187 | ReportInfo.Insert(2, CurrentLib.DocumentName); 188 | GenerateReport(ReportInfo, 'SchLibPartPinCountReport.txt'); 189 | 190 | ReportInfo.Free; 191 | End; 192 | 193 | {..............................................................................} 194 | End. 195 | 196 | -------------------------------------------------------------------------------- /SchLib/PinFunctions/Pinfunctions.txt: -------------------------------------------------------------------------------- 1 | # Text File Format: 2 | # delimited. 3 | # pin-des FN1 FN2 4 | 28 RA1 5 | 27 RA0 6 | 26 RE3 MCLR VPP 7 | 25 RB7 ICSPDAT 8 | 24 RB6 ICSPCLK 9 | -------------------------------------------------------------------------------- /SchLib/PinFunctions/SymbolPinFunctions.txt: -------------------------------------------------------------------------------- 1 | # Text File Format: 2 | # delimited. 3 | # pin-des FN1 FN2 4 | 5 | # empty name test 6 | 28 7 | # space for name test 8 | 27 N 9 | 26 RE3 MCLR VPP 10 | 25 RB7 ICSPDAT 11 | 24 RB6 ICSPCLK 12 | -------------------------------------------------------------------------------- /System/AltiumLivePortalRegSettings.pas: -------------------------------------------------------------------------------- 1 | { AltiumLivePortalRegSeyttings.pas 2 | 3 | Works on current running Altium Registry path. 4 | 5 | B.L Miller 6 | 2024-02-22 v0.10 POC 7 | 8 | IOptionsWriter methods IOptionsWriter properties 9 | EraseSection 10 | WriteBoolean 11 | WriteDouble 12 | WriteInteger 13 | WriteString 14 | 15 | IOptionsReader methods IOptionsReader properties 16 | ReadBoolean 17 | ReadDouble 18 | ReadInteger 19 | ReadString 20 | ReadSection 21 | SectionExists 22 | ValueExists 23 | 24 | IOptionsManager methods IOptionsManager properties 25 | GetOptionsReader 26 | GetOptionsWriter 27 | OptionsExist 28 | 29 | } 30 | 31 | const 32 | cRegistrySubPath = '\DesignExplorer\Preferences\'; // registry path to prefs from AD-install root. 33 | 34 | cNameOfServer = 'AltiumPortal'; 35 | // cSectionNamesExport = 'Access|Client Preferences|Options Pages|Custom Colors'; 36 | cSectionNamesExport = 'Account'; 37 | cSectionNamesImport = 'Account'; 38 | 39 | // only supports string! 40 | cImportKeys = 'Username=Mickey Mouse'; // |RememberUsername=1'; 41 | 42 | var 43 | OptionsMan : IOptionsManager; 44 | SectionNames : TStringList; 45 | SectKeys : TStringList; 46 | Report : TStringList; 47 | ReportDoc : IServerDocument; 48 | AValue : WideString; 49 | Flag : Integer; 50 | Filename : WideString; 51 | ViewState : WideString; 52 | 53 | function RegistryWriteString(const SKey : Widestring, const IKey : WideString, const IVal : WideString) : boolean; forward; 54 | 55 | procedure ReportRegistrySettings; 56 | Var 57 | Reader : IOptionsReader; 58 | SectName : WideString; 59 | I, J : integer; 60 | KeyName : WideString; 61 | strValue : WideString; 62 | 63 | Begin 64 | OptionsMan := Client.OptionsManager; 65 | if OptionsMan = nil then exit; 66 | Reader := OptionsMan.GetOptionsReader(cNameOfServer, ''); 67 | 68 | If Reader = Nil Then 69 | begin 70 | ShowMessage('no options found '); 71 | Exit; 72 | end; 73 | 74 | Report := TStringList.Create; 75 | 76 | SectName := cSectionNamesExport; // load from const 77 | 78 | SectKeys := TStringList.Create; 79 | SectKeys.Delimiter := #13; 80 | SectKeys.StrictDelimiter := true; 81 | // SectKeys.NameValueSeparator := '='; 82 | 83 | Filename := ''; 84 | ReportDoc := nil; 85 | Report.Add(SpecialKey_SoftwareAltiumApp); 86 | Report.Add(cNameOfServer); 87 | 88 | if Reader.SectionExists(SectName) then 89 | begin 90 | AValue := Reader.ReadSection(SectName); 91 | SectKeys.DelimitedText := AValue; 92 | Report.Add(SectName + ' option count : ' + IntToStr(SectKeys.Count)); 93 | 94 | for I := 0 to (SectKeys.Count - 1) do 95 | begin 96 | KeyName := trim(SectKeys.Strings(I)); // need to trim to find it! 97 | 98 | strValue := ''; 99 | if Reader.ValueExists(SectName, KeyName) then 100 | begin 101 | strValue := Reader.ReadString(SectName, KeyName, ''); 102 | end; 103 | 104 | Report.Add(IntToStr(I) + ' ' + PadRight(KeyName, 45) + ' = ' + strValue ); 105 | end; 106 | Report.Add(''); 107 | 108 | end else 109 | ShowMessage('section ' + SectName + ' not found'); 110 | 111 | Report.Add(''); 112 | 113 | Filename := SpecialFolder_TemporarySlash + cNameOfServer + '-RegRpt.txt'; 114 | Report.SaveToFile(Filename); 115 | 116 | SectKeys.Free; 117 | Report.Free; 118 | 119 | if FileName <> '' then 120 | ReportDoc := Client.OpenDocument('Text', FileName); 121 | If ReportDoc <> Nil Then 122 | begin 123 | Client.ShowDocument(ReportDoc); 124 | if (ReportDoc.GetIsShown <> 0 ) then 125 | ReportDoc.DoFileLoad; 126 | end; 127 | end; 128 | 129 | procedure WriteRegistrySetting; 130 | var 131 | Writer : IOptionsWriter; 132 | Reader : IOptionsReader; 133 | SectName : WideString; 134 | RegSectKey : WideString; 135 | I : integer; 136 | KeyName : WideString; 137 | KeyValue : WideString; 138 | strValue : WideString; 139 | bSuccess : boolean; 140 | 141 | begin 142 | OptionsMan := Client.OptionsManager; 143 | if OptionsMan = nil then exit; 144 | Reader := OptionsMan.GetOptionsReader(cNameOfServer, ''); 145 | Writer := OptionsMan.GetOptionsWriter(cNameOfServer); 146 | 147 | If (Writer = nil) or (Reader = nil) Then 148 | begin 149 | // ShowMessage('no options found '); 150 | Exit; 151 | end; 152 | 153 | 154 | SectName := cSectionNamesImport; 155 | 156 | SectKeys := TStringList.Create; 157 | SectKeys.Delimiter := '|'; 158 | SectKeys.StrictDelimiter := true; 159 | SectKeys.NameValueSeparator := '='; 160 | SectKeys.DelimitedText := cImportKeys; 161 | 162 | if OptionsMan.OptionsExist(cNameOfServer,'') then 163 | begin 164 | Client.ArePreferencesReadOnly(cNameOfserver, SectName); 165 | 166 | if Reader.SectionExists(SectName) then 167 | begin 168 | // IniFile.ReadSectionValues(SectName, SectKeys); 169 | 170 | for I := 0 to (SectKeys.Count - 1) do 171 | begin 172 | KeyName := SectKeys.Names(I); 173 | KeyValue := SectKeys.ValueFromIndex(I); 174 | 175 | strValue := Reader.ReadString(SectName, KeyName, ''); 176 | 177 | // write to Server Options 178 | Writer.WriteString(SectName, KeyName, KeyValue); 179 | // write to Registry 180 | RegSectKey := SpecialKey_SoftwareAltiumApp + cRegistrySubPath + cNameOfServer + '\' + SectName; 181 | bSuccess := RegistryWriteString(RegSectKey, KeyName, KeyValue); 182 | 183 | if bSuccess then 184 | if KeyValue <> strValue then 185 | Showmessage('changed ' + KeyName + ' from: ' + strValue +' to: ' + KeyValue); 186 | end; 187 | end 188 | else 189 | ShowMessage('server does not have this section ' + SectName); 190 | 191 | SectKeys.Clear; 192 | end; 193 | 194 | Reader := nil; 195 | Writer := nil; 196 | // IniFile.Free; 197 | 198 | client.SetPreferencesChanged(true); 199 | end; 200 | 201 | function RegistryWriteString(const SKey : Widestring, const IKey : WideString, const IVal : WideString) : boolean; 202 | var 203 | Registry : TRegistry; 204 | RegDataInfo : TRegDataInfo; 205 | Begin 206 | Result := false; 207 | Registry := TRegistry.Create; 208 | 209 | Registry.OpenKey(SKey, true); 210 | if Registry.ValueExists(IKey) then 211 | begin 212 | RegDataInfo := Registry.GetDataType(IKey); 213 | if RegDataInfo = rdString then 214 | begin 215 | Result := true; 216 | Registry.WriteString(IKey, IVal); 217 | end; 218 | end; 219 | Registry.CloseKey; 220 | Registry.Free; 221 | End; 222 | 223 | -------------------------------------------------------------------------------- /System/CoordError.pas: -------------------------------------------------------------------------------- 1 | { CoordToErrors.pas 2 | and VarTypes 3 | 4 | Author BLMiller 5 | 20231209 POC 6 | 20231211 Add CoordRealMils & RealMMs output 7 | } 8 | const 9 | VarTypeMask = $0FFF; 10 | cValue = 456; 11 | var 12 | myVar : Variant; 13 | Report : TStringList; 14 | 15 | function ShowBasicVariantType(varVar: Variant) : WideString; forward; 16 | 17 | procedure main; 18 | var 19 | i, j : integer; 20 | begin 21 | Report := TStringList.Create; 22 | Report.Add(Client.GetProductVersion); 23 | 24 | // Assign various values to a Variant 25 | // and then show the resulting Variant type 26 | ShowMessage('Variant value = not yet set is ' + ShowBasicVariantType(myVar) ); 27 | 28 | // Simple value 29 | myVar := 123; 30 | ShowMessage('Variant value = 123 is ' + ShowBasicVariantType(myVar) ); 31 | 32 | // Calculated value using a Variant and a constant 33 | myVar := myVar + cValue; 34 | ShowMessage('Variant value = 123 + const ' + IntToStr(cValue) + ' is ' + ShowBasicVariantType(myVar) ); 35 | 36 | myVar := 'String ' + IntToStr(myVar); 37 | ShowMessage('Variant value = String of ' + myVar + ' is ' + ShowBasicVariantType(myVar) ); 38 | 39 | myVar := cPI; 40 | ShowMessage('Variant value = pi is ' + ShowBasicVariantType(myVar) ); 41 | 42 | myVar := CoordToMMs(10011); 43 | ShowMessage('Variant 10011 Coord= ' + FloatToStr(myVar) + 'mm is ' + ShowBasicVariantType(myVar) ); 44 | myVar := CoordToMils(10011); 45 | ShowMessage('Variant 10011 Coord= ' + FloatToStr(myVar) + 'mil is ' + ShowBasicVariantType(myVar) ); 46 | 47 | // kMaxCoord; 48 | // kMinCoord; 49 | // k1Mil; 50 | // cMaxWorkspaceSize; 51 | 52 | // MilsToRealCoord(); 53 | // myVar := CoordToMMs_FullPrecision(10011); 54 | 55 | // ShowMessage('Variant 10011 Coord = ' + FloatToStr(myVar) + ShowBasicVariantType(myVar) ); 56 | 57 | ShowMessage('Error of CoordToMMs in mm ' + FloatTostr( CoordToMMs_FullPrecision(10011) - CoordToMMs(10011) )); 58 | ShowMessage('Error of CoordToMils in Coord' + FloatTostr( (CoordToMils(10011) - (10011 / k1Mil)) * k1Mil )); 59 | ShowMessage('Error of CoordToMils in Coord' + FloatTostr( (CoordToMils(10009) - (10009 / k1Mil)) * k1Mil )); 60 | 61 | Report.Add('k1Mil' +'|'+ IntToStr(k1Mil)); 62 | Report.Add('k1Inch' +'|'+ IntToStr(k1Inch)); 63 | Report.Add(''); 64 | Report.Add('val | CoordToMMs | CoordToMMs_FullPrecision | /k1Inch * 25.4'); 65 | for i := 0 to 100 do 66 | begin 67 | j := i * 1; 68 | Report.Add(IntToStr(j) + '|' + FloatTostr(CoordToMMs(j)) + '|' + FloatTostr(CoordToMMs_FullPrecision(j)) + '|' + FloatTostr(j / k1Inch * 25.4)); 69 | end; 70 | 71 | // returns rounded integer value 72 | Report.Add(''); 73 | Report.Add('val | MMsToCoord | MMsToRealCoord() | *k1Inch / 25.4'); 74 | for i := 0 to 100 do 75 | begin 76 | j := i * 1/100; 77 | Report.Add(IntToStr(j) + '|' + FloatTostr(MMsToCoord(j)) + '|' + FloatTostr(MMsToRealCoord(j)) + '|' +FloatTostr(j * k1Inch / 25.4)); 78 | end; 79 | 80 | Report.Add(''); 81 | Report.Add('val | CoordToMils | CoordToRealMils | /k1Mil'); 82 | 83 | for i := 0 to 100 do 84 | begin 85 | j := i * 107; 86 | Report.Add(IntToStr(j) + '|' + FloatTostr(CoordToMils(j)) + '|' + FloatTostr(MilsToRealCoord(j))+ '|' + FloatTostr(j / k1Mil) ); 87 | end; 88 | Report.SaveToFile('c:\temp\CoordErrors.txt'); 89 | end; 90 | 91 | // Show the type of a variant 92 | function ShowBasicVariantType(varVar: Variant) : WideString; 93 | var 94 | typeString : string; 95 | basicType : Integer; 96 | 97 | begin 98 | // Get the Variant basic type : 99 | // this means excluding array or indirection modifiers 100 | basicType := VarType(varVar) and VarTypeMask; 101 | 102 | // Set a string to match the type 103 | case basicType of 104 | varEmpty : typeString := 'varEmpty'; 105 | varNull : typeString := 'varNull'; 106 | varSmallInt : typeString := 'varSmallInt'; 107 | varInteger : typeString := 'varInteger'; 108 | varSingle : typeString := 'varSingle'; 109 | varDouble : typeString := 'varDouble'; 110 | varCurrency : typeString := 'varCurrency'; 111 | varDate : typeString := 'varDate'; 112 | varOleStr : typeString := 'varOleStr'; 113 | varDispatch : typeString := 'varDispatch'; 114 | varError : typeString := 'varError'; 115 | varBoolean : typeString := 'varBoolean'; 116 | varVariant : typeString := 'varVariant'; 117 | varUnknown : typeString := 'varUnknown'; 118 | varByte : typeString := 'varByte'; 119 | varWord : typeString := 'varWord'; 120 | varLongWord : typeString := 'varLongWord'; 121 | varInt64 : typeString := 'varInt64'; 122 | varStrArg : typeString := 'varStrArg'; 123 | varString : typeString := 'varString'; 124 | varAny : typeString := 'varAny'; 125 | varTypeMask : typeString := 'varTypeMask'; 126 | end; 127 | 128 | Result := typeString; 129 | // Show the Variant type 130 | // ShowMessage('Variant type is '+typeString); 131 | end; 132 | -------------------------------------------------------------------------------- /System/CustomColours.pas: -------------------------------------------------------------------------------- 1 | { CustomColours.pas 2 | 3 | 3x 8bit colour BGR format 4 | 5 | Works on current running Altium Registry path. 6 | Export Custom colours from Registry to an ini-file BGR format. 7 | Import from an user ini-file to the server preferences in Registry. 8 | Have to close & re-open Altium to refresh internal Custom Colours. 9 | 10 | User can edit ini file directly to add new colours BGR format. 11 | Colours stored in ini file as BGR value (3 bytes unsigned) of value: min=0 & max=0xFFFFFF 12 | Value can be represented as integer or hex string (requires "$" prefix) 13 | It might support hexstring prefix "0x" 14 | 15 | can use IOptionsReader/Writer or IRegistry interfaces to R/W the registry. 16 | Both work, both appear to do same thing. 17 | IRegistry interface not fully utilised. 18 | 19 | Note: 20 | Import loading to server seems pointless as servers can not be made to refresh. 21 | 22 | B.L Miller 23 | 11/08/2022 v0.11 POC 24 | 12/08/2022 v0.12 use hex in inifile to ease RGB readability. Sanitise input values from inifile. 25 | 14/08/2022 v0.13 pop up the Colour form dialog 26 | 18/08/2022 v0.14 registry path was missing server name. 27 | 28 | IOptionsWriter methods IOptionsWriter properties 29 | EraseSection 30 | WriteBoolean 31 | WriteDouble 32 | WriteInteger 33 | WriteString 34 | 35 | IOptionsReader methods IOptionsReader properties 36 | ReadBoolean 37 | ReadDouble 38 | ReadInteger 39 | ReadString 40 | ReadSection 41 | SectionExists 42 | ValueExists 43 | 44 | IOptionsManager methods IOptionsManager properties 45 | GetOptionsReader 46 | GetOptionsWriter 47 | OptionsExist 48 | 49 | IRegistry // many parallel functions to OptionReader/Writer but more flexible. 50 | IDocumentOptionsSet // interesting, but does not seem useful. 51 | } 52 | 53 | // Registry paths & special keys. 54 | // vv SpecialKey_SoftwareAltiumApp vv 55 | // HKEY_CURRENT_USER/Software/Altium/Altium Designer {FB13163A-xxxxxxxxxxxxx}/DesignExplorer/Preferences 56 | 57 | const 58 | cRegistrySubPath = '\DesignExplorer\Preferences\'; // registry path to prefs from AD-install root. 59 | 60 | cNameOfServer = 'Client'; 61 | // cSectionNamesExport = 'Access|Client Preferences|Options Pages|Custom Colors'; 62 | cSectionNamesExport = 'Custom Colors'; 63 | cSectionNamesImport = 'Custom Colors'; 64 | 65 | var 66 | SectionNames : TStringList; 67 | SectKeys : TStringList; 68 | 69 | Report : TStringList; 70 | ReportDoc : IServerDocument; 71 | AValue : WideString; 72 | Flag : Integer; 73 | Filename : WideString; 74 | ViewState : WideString; 75 | 76 | function RegistryWriteString(const SKey : Widestring, const IKey : WideString, const IVal : WideString) : boolean; 77 | var 78 | Registry : TRegistry; 79 | Begin 80 | Result := false; 81 | Registry := TRegistry.Create; 82 | Try 83 | Registry.OpenKey(SKey, true); 84 | if Registry.ValueExists(IKey) then 85 | Result := true; // Registry.ReadString(IKey); 86 | // rdString 87 | Registry.WriteString(IKey, IVal); 88 | Registry.CloseKey; 89 | 90 | Finally 91 | Registry.Free; 92 | End; 93 | End; 94 | 95 | function RegistryWriteInteger(const SKey : Widestring, const IKey : WideString, const IVal : Integer) : boolean; 96 | var 97 | Registry : TRegistry; 98 | RegDataInfo : TRegDataInfo; 99 | Begin 100 | Result := false; 101 | Registry := TRegistry.Create; 102 | Try 103 | Registry.OpenKey(SKey, true); 104 | if Registry.ValueExists(IKey) then 105 | begin 106 | RegDataInfo := Registry.GetDataType(IKey); 107 | if RegDataInfo = rdInteger then 108 | begin 109 | Registry.WriteInteger(IKey, IVal); 110 | Result := true; 111 | end; 112 | end; 113 | Registry.CloseKey; 114 | Finally 115 | Registry.Free; 116 | End; 117 | End; 118 | 119 | procedure ImportCustomColours; 120 | Var 121 | OpenDialog : TOpenDialog; 122 | Reader : IoptionsReader; 123 | Writer : IOptionsWriter; 124 | IniFile : TMemIniFile; // do NOT use TIniFile for READING as strips quotes at each end! 125 | I : integer; 126 | OptionsMan : IOptionsManager; 127 | SectName : WideString; 128 | KeyName : WideString; 129 | KeyValue : WideString; 130 | intValue : Integer; 131 | RegSectKey : WideString; 132 | RegItemKey : WideString; 133 | Button : WideString; 134 | bSuccess : boolean; 135 | 136 | Begin 137 | OptionsMan := Client.OptionsManager; 138 | 139 | Writer := OptionsMan.GetOptionsWriter(cNameOfServer); 140 | Reader := OptionsMan.GetOptionsReader(cNameOfServer,''); 141 | 142 | If (Writer = nil) or (Reader = nil) Then 143 | begin 144 | // ShowMessage('no options found '); 145 | Exit; 146 | end; 147 | 148 | OpenDialog := TOpenDialog.Create(Application); 149 | OpenDialog.Title := 'Import ' + cNameOfServer + '_' + cSectionNamesImport + ' *.ini file'; 150 | OpenDialog.Filter := 'INI file (*.ini)|*.ini'; 151 | // OpenDialog.InitialDir := ExtractFilePath(Board.FileName); 152 | OpenDialog.FileName := cNameOfServer + '_' + cSectionNamesImport + '*.ini'; 153 | Flag := OpenDialog.Execute; 154 | if (Flag = 0) then exit; 155 | FileName := OpenDialog.FileName; 156 | IniFile := TMemIniFile.Create(FileName); 157 | 158 | SectName := cSectionNamesImport; 159 | 160 | SectKeys := TStringList.Create; 161 | SectKeys.Delimiter := '='; 162 | SectKeys.StrictDelimiter := true; 163 | // SectKeys.NameValueSeparator := '='; 164 | 165 | if OptionsMan.OptionsExist(cNameOfServer,'') then 166 | begin 167 | Client.ArePreferencesReadOnly(cNameOfserver, SectName); 168 | 169 | if IniFile.SectionExists(SectName) then 170 | if Reader.SectionExists(SectName) then 171 | begin 172 | IniFile.ReadSectionValues(SectName, SectKeys); 173 | 174 | for I := 0 to (SectKeys.Count - 1) do 175 | begin 176 | KeyName := SectKeys.Names(I); 177 | KeyValue := SectKeys.ValueFromIndex(I); 178 | 179 | // hex or int string to int & sanitise 180 | if KeyValue = '' then KeyValue :='0'; 181 | intValue := StrToInt(KeyValue); 182 | if (IntValue < 0) then IntValue := 0; 183 | if (IntValue > $FFFFFF) then IntValue := $FFFFFF; 184 | 185 | // write to Server Options 186 | Writer.WriteInteger(SectName, KeyName, IntValue); 187 | // write to Registry 188 | RegSectKey := SpecialKey_SoftwareAltiumApp + cRegistrySubPath + cNameOfServer + '\' + SectName; 189 | bSuccess := RegistryWriteInteger(RegSectKey, KeyName, IntValue); 190 | end; 191 | end 192 | else 193 | ShowMessage('server does not have this section ' + SectName); 194 | 195 | SectKeys.Clear; 196 | end; 197 | 198 | Reader := nil; 199 | Writer := nil; 200 | IniFile.Free; 201 | 202 | client.SetPreferencesChanged(true); 203 | Client.GUIManager.UpdateInterfaceState; 204 | 205 | bSuccess := false; 206 | ResetParameters; 207 | AddStringParameter('Dialog','Color'); 208 | // AddStringParameter('Color', '0'); 209 | RunProcess('Client:RunCommonDialog'); 210 | 211 | // non blocking & no return value then causes DLL crash ??? 212 | // Client.SendMessage('Client:RunCommonDialog', 'Dialog=Color', 512, Client.CurrentView); 213 | // DNW 214 | // Server.CommandLauncher.LaunchCommand('Client:RunCommonDialog', 'Dialog=Color', 512,Client.CurrentView); 215 | 216 | GetStringParameter('Result', Button); 217 | if (Button = 'True') then 218 | begin 219 | bSuccess := true; 220 | GetStringParameter('Color',KeyValue); 221 | // ShowInfo('New color is ' + KeyValue); 222 | End; 223 | if not bSuccess then 224 | ShowMessage('Close & reopen Altium to get new colours, sorry..'); 225 | End; 226 | 227 | procedure ExportCustomColours; 228 | Var 229 | // FileName : String; 230 | SaveDialog : TSaveDialog; 231 | Reader : IOptionsReader; // TRegistryReader 232 | Reader2 : IOptionsReader; 233 | IniFile : TIniFile; // do NOT use TIniFile for READING as strips quotes at each end! 234 | SectName : WideString; 235 | I, J : integer; 236 | KeyName : WideString; 237 | dblValue : TExtended; 238 | intValue : Integer; 239 | Datatype : Widestring; 240 | 241 | Begin 242 | Reader := Client.OptionsManager.GetOptionsReader(cNameOfServer, ''); 243 | 244 | If Reader = Nil Then 245 | begin 246 | ShowMessage('no options found '); 247 | Exit; 248 | end; 249 | 250 | SaveDialog := TSaveDialog.Create(Application); 251 | SaveDialog.Title := 'Export ' + cNameOfServer + '_' + cSectionNamesExport + ' *.ini file'; 252 | SaveDialog.Filter := 'INI file (*.ini)|*.ini'; 253 | FileName := cNameOfServer + '_' + cSectionNamesExport + '.ini'; 254 | SaveDialog.FileName := FileName; 255 | 256 | Flag := SaveDialog.Execute; 257 | if (Flag = 0) then exit; 258 | 259 | Report := TStringList.Create; 260 | 261 | // Get file & set extension 262 | FileName := SaveDialog.FileName; 263 | FileName := ChangeFileExt(FileName, '.ini'); 264 | IniFile := TIniFile.Create(FileName); 265 | 266 | SectName := cSectionNamesExport; // load from const 267 | 268 | SectKeys := TStringList.Create; 269 | SectKeys.Delimiter := #13; 270 | SectKeys.StrictDelimiter := true; 271 | // SectKeys.NameValueSeparator := '='; 272 | 273 | Filename := ''; 274 | ReportDoc := nil; 275 | Report.Add(SpecialKey_SoftwareAltiumApp); 276 | Report.Add(cNameOfServer); 277 | 278 | if Reader.SectionExists(SectName) then 279 | begin 280 | AValue := Reader.ReadSection(SectName); 281 | SectKeys.DelimitedText := AValue; 282 | Report.Add(SectName + ' option count : ' + IntToStr(SectKeys.Count)); 283 | 284 | for I := 0 to (SectKeys.Count - 1) do 285 | begin 286 | KeyName := trim(SectKeys.Strings(I)); // need to trim to find it! 287 | 288 | intValue := 0; 289 | if Reader.ValueExists(SectName, KeyName) then 290 | begin 291 | // registry key value is DWord integer 292 | intValue := Reader.ReadInteger(SectName, KeyName, -999991); 293 | 294 | // store with hex prefix to allow storage of hex & decimal integer. 295 | AValue := '$' + IntToHex(intValue, 6); // 6 char = 3x 2 (2 char/byte) unsigned 296 | 297 | IniFile.WriteString(SectName, KeyName, AValue); 298 | end; 299 | 300 | Report.Add(IntToStr(I) + ' ' + PadRight(KeyName, 45) + ' = ' + IntToStr(intValue) + ' BGR ' + AValue); 301 | end; 302 | 303 | IniFile.WriteString('Comment', 'DataFormat', 'BGR 3x 8bit: $hex or int'); 304 | Report.Add(''); 305 | 306 | end else 307 | ShowMessage('section ' + SectName + ' not found'); 308 | 309 | Report.Add('Colours stored as 3 bytes BGR'); 310 | 311 | Filename := SpecialFolder_TemporarySlash + cNameOfServer + '-CustomColours-ExportReport.txt'; 312 | Report.SaveToFile(Filename); 313 | 314 | SectKeys.Free; 315 | Report.Free; 316 | IniFile.Free; 317 | 318 | if FileName <> '' then 319 | ReportDoc := Client.OpenDocument('Text', FileName); 320 | If ReportDoc <> Nil Then 321 | begin 322 | Client.ShowDocument(ReportDoc); 323 | if (ReportDoc.GetIsShown <> 0 ) then 324 | ReportDoc.DoFileLoad; 325 | end; 326 | end; 327 | -------------------------------------------------------------------------------- /System/DialogClose/DialogClose.pas: -------------------------------------------------------------------------------- 1 | { DialogClose.pas 2 | 3 | B. Miller 4 | 03/11/2020 v0.10 POC collect scripts together. 5 | 10/11/2020 v0.11 Get parameter passing to vbs script. 6 | 7 | should be possible to bypass using CMD shell & directly call VBS script. 8 | } 9 | 10 | const 11 | CmdBatchFileFullPath = '"C:\Altium Projects\Scripts\System\DialogClose\StartAndReturn.bat"'; 12 | Parameters = '5000'; 13 | 14 | procedure UnitTest; 15 | var 16 | ErrorCode : integer; 17 | 18 | begin 19 | ErrorCode := RunApplication('cmd /c ' + CmdBatchFileFullPath + ' ' + Parameters); // this does NOT wait, return value errorcode for launch 20 | // ErrorcCode := RunApplicationAndWait('name', time); // make time = small timeout 21 | 22 | ShowMessage('This message will self-destruct in ' + Parameters + 'ms'); 23 | end; 24 | -------------------------------------------------------------------------------- /System/DialogClose/FocusAltium.vbs: -------------------------------------------------------------------------------- 1 | ' Focus Altium app & send keycode 2 | ' will close &/or Okay open/blocking/modal dialogs 3 | 4 | Dim ObjShell 5 | Dim testArg 6 | 7 | Set objArgs = Wscript.Arguments 8 | 9 | testArg = 1000 10 | 11 | if objArgs.Count > 0 then 12 | testArg = objArgs(0) 13 | end if 14 | 15 | ' Wscript.Echo now &": "& testArg 16 | 17 | Set ObjShell = CreateObject("Wscript.Shell") 18 | 19 | ' show user Altium script message 20 | ObjShell.AppActivate("Altium") 21 | 22 | Wscript.Sleep testArg 23 | 24 | ' user may have moved focus to another app/screen/window 25 | ObjShell.AppActivate("Altium") 26 | ObjShell.SendKeys "{ENTER}" 27 | -------------------------------------------------------------------------------- /System/DialogClose/StartAndReturn.bat: -------------------------------------------------------------------------------- 1 | Rem ' StartAndReturn.bat 2 | Rem ' full path may not be required (same folder) in MS-Windows. 3 | 4 | start /b wscript "C:\Altium Projects\Scripts\System\DialogClose\FocusAltium.vbs" %1 5 | 6 | rem echo %1 > c:\temp\cmdpara.txt 7 | -------------------------------------------------------------------------------- /System/InstallSummary.pas: -------------------------------------------------------------------------------- 1 | { List all installed AltiumDesigner .. 2 | 3 | HKey_Local_Machine HKey_Current_User 4 | Registry.RootKey := HKEY_CURRENT_USER; 5 | 6 | 7 | BL Miller 8 | 26/10/2020 v0.10 POC list Altium Install registry entries.. 9 | v0.11 Added some install Preferences to report 10 | 27/10/2020 v0.12 Use Special folder if only project is Free Documents & blank path. CurrentDir is not reliable RW path. 11 | 14/08/2022 v0.13 Check paths/folders exist. 12 | 13 | 14 | TBD: 15 | No 32 - 64 bit cross support.. 16 | If run from AD17 then ONLY 32bit registry is checked. 17 | If run from AD18+ then only 64bit installs are found. 18 | 19 | // vv SpecialKey_SoftwareAltiumApp vv 20 | // HKEY_LOCAL_MACHINE/Software/Altium/Builds/Altium Designer {Fxxxxxxx-xxxxxxxxxxxxx}/*items 21 | // HKEY_CURRENT_USER/Software/Altium/Altium Designer {Fxxxxxxx-xxxxxxxxxxxxx}/DesignExplorer/Preferences 22 | } 23 | 24 | const 25 | { Reserved Key Handles. missing in DelphiScript} 26 | HKEY_CLASSES_ROOT = $80000000; 27 | HKEY_CURRENT_USER = $80000001; 28 | HKEY_LOCAL_MACHINE = $80000002; 29 | HKEY_USERS = $80000003; 30 | HKEY_PERFORMANCE_DATA = $80000004; 31 | HKEY_CURRENT_CONFIG = $80000005; 32 | HKEY_DYN_DATA = $80000006; 33 | 34 | cRegistrySubPath = '\Software\Altium\Builds'; // Machine installs 35 | cRegistrySubPath2 = '\Software\Altium'; // User prefs 36 | cRegistrySubPath3 = '\DesignExplorer\Preferences'; // User prefs 37 | 38 | // paralist of ItemKeys to report from Software\Altium\Builds\SpecialKey\.. 39 | csItemKeys = 'Application|Build|Display Name|ProgramsInstallPath|FullBuild|ReleaseDate|DocumentsInstallPath|Security|UniqueID|Version|Win64'; 40 | csReportPaths = 'ProgramsInstallPath|DocumentsInstallPath|Template Path|InstalledRelativePath'; 41 | // ..Software\Altium\\SpecialKey\DesignExplorer\Preferences\ 42 | csItemKeys2 = 'WorkspaceManager\Workspace Preferences\Template Path|PcbDrawing\PcbDrawing\DocumentTemplatesLocation|IntegratedLibrary\Add Remove\InstalledRelativePath' 43 | + '|AltiumPortal\Account\Username'; 44 | 45 | var 46 | Registry : TRegistry; 47 | RegDataInfo : TRegDataInfo; 48 | SectKeyList : TStringlist; 49 | ItemKeyList : TStringList; 50 | Report : TStringList; 51 | Project : IProject; 52 | FilePath : WideString; 53 | ReportDocument : IServerDocument; 54 | 55 | function RegistryReadString(const SKey : WideString, const IKey : Widestring) : WideString; forward; 56 | function RegistryReadSectKeys(const SKey : WideString) : TStringList; forward; 57 | function RegistryReadKeyType(const SKey : WideString, const IKey : Widestring) : TRegDataInfo; forward; 58 | 59 | procedure ItemPathToSection (var SPath, var KPath : WideString); 60 | var 61 | pos : integer; 62 | begin 63 | SPath := SPath + '\' + ExtractFilePath(KPath); 64 | SPath := RemovePathSeparator(SPath); 65 | KPath := ExtractFileName(KPath); 66 | end; 67 | 68 | procedure ListTheInstalls; 69 | Var 70 | SectKey : WideString; 71 | ItemKey : WideSting; 72 | ItemKey2 : WideSting; 73 | KeyValue : WideString; 74 | DirExists : WideString; 75 | S, I : integer; 76 | 77 | begin 78 | Report := TStringList.Create; 79 | 80 | Registry := TRegistry.Create; // TRegistry.Create(KEY_WRITE OR KEY_WOW64_64KEY); KEY_SET_VALUE 81 | 82 | ItemKeyList := TStringList.Create; 83 | ItemKeyList.Delimiter := '|'; 84 | ItemKeyList.StrictDelimiter := true; 85 | ItemKeyList.DelimitedText := csItemKeys; 86 | 87 | Registry.RootKey := HKEY_LOCAL_MACHINE; 88 | // Registry.CurrentPath := HKEY_Root; // read only 89 | 90 | // do NOT include the RootKey Path 91 | SectKey := cRegistrySubPath; 92 | SectKeyList := RegistryReadSectKeys(SectKey); 93 | 94 | for S := 0 to (SectKeyList.Count - 1) do 95 | begin 96 | SectKey := SectkeyList.Strings(S); 97 | Report.Add('Section : ' + IntToStr(S) + ' ' + SectKey); 98 | for I := 0 to (ItemKeyList.Count - 1) do 99 | begin 100 | ItemKey := ItemKeyList.Strings(I); 101 | 102 | // don't forget the damn separator '\' 103 | RegDataInfo := RegistryReadKeyType(cRegistrySubPath + '\' + SectKey, ItemKey); 104 | // should check & handle other datatypes.. 105 | KeyValue := RegistryReadString(cRegistrySubPath + '\' + SectKey, ItemKey); 106 | 107 | DirExists := ''; 108 | if (ansipos(ItemKey, csReportpaths) > 0) then 109 | begin 110 | DirExists := 'path: NOT found'; 111 | if DirectoryExists(KeyValue) then 112 | DirExists := 'path: good'; 113 | end; 114 | 115 | Report.Add(PadRight(IntToStr(S) + '.' + IntToStr(I),4) + ' ' + PadRight(ItemKey,30) + ' = ' + PadRight(KeyValue,60) + ' datatype : ' +IntToStr(RegDataInfo) + ' ' + DirExists); 116 | end; 117 | Report.Add(''); 118 | end; 119 | 120 | ItemKeyList.Clear; 121 | ItemKeyList.DelimitedText := csItemKeys2; 122 | 123 | Registry.RootKey := HKEY_CURRENT_USER; 124 | 125 | for S := 0 to (SectKeyList.Count - 1) do 126 | begin 127 | SectKey := SectkeyList.Strings(S); 128 | Report.Add('Section : ' + IntToStr(S) + ' ' + SectKey); 129 | for I := 0 to (ItemKeyList.Count - 1) do 130 | begin 131 | ItemKey := ItemKeyList.Strings(I); 132 | // don't forget the damn separator '\' 133 | SectKey := cRegistrySubPath2 + '\' + SectkeyList.Strings(S) + cRegistrySubPath3; 134 | ItemKey2 := ItemKey; 135 | ItemPathToSection (SectKey, ItemKey2); 136 | RegDataInfo := RegistryReadKeyType(SectKey, ItemKey2); 137 | KeyValue := RegistryReadString(SectKey, ItemKey2); 138 | 139 | DirExists := ''; 140 | if (ansipos(ItemKey2, csReportpaths) > 0) then 141 | begin 142 | DirExists := 'path: NOT found'; 143 | if DirectoryExists(KeyValue) then 144 | DirExists := 'path: good'; 145 | end; 146 | 147 | Report.Add(PadRight(IntToStr(S) + '.' + IntToStr(I),4) + ' ' + ExtractFilePath(ItemKey)); 148 | Report.Add(PadRight(IntToStr(S) + '.' + IntToStr(I),4) + ' ' + PadRight(ItemKey2,30) + ' = ' + PadRight(KeyValue,60) + ' datatype : ' +IntToStr(RegDataInfo) + ' ' + DirExists); 149 | end; 150 | Report.Add(''); 151 | end; 152 | 153 | ItemKeyList.Free; 154 | 155 | SectKeyList.Delimiter := #13; 156 | SectKeyList.Insert(0,'List of installs : '); 157 | // ShowMessage(SectKeyList.DelimitedText); 158 | 159 | if Registry <> nil then Registry.Free; 160 | SectKeyList.Free; 161 | 162 | Project := GetWorkSpace.DM_FocusedProject; 163 | FilePath := ExtractFilePath(Project.DM_ProjectFullPath); 164 | if (Project.DM_ProjectFullPath = 'Free Documents') or (FilePath = '') then 165 | FilePath := SpecialFolder_AllUserDocuments; // GetCurrentDir; 166 | 167 | FilePath := FilePath + '\AD_Installs_Report.Txt'; 168 | Report.Insert(0, 'Report Altium Installs in Registry'); 169 | Report.SaveToFile(FilePath); 170 | Report.Free; 171 | 172 | //Prj.DM_AddSourceDocument(FilePath); 173 | ReportDocument := Client.OpenDocument('Text', FilePath); 174 | 175 | If ReportDocument <> Nil Then 176 | begin 177 | Client.ShowDocument(ReportDocument); 178 | if (ReportDocument.GetIsShown <> 0 ) then 179 | ReportDocument.DoFileLoad; 180 | end; 181 | end; 182 | 183 | function RegistryReadSectKeys(const SKey : WideString) : TStringList; 184 | Begin 185 | Result := TStringList.Create; 186 | Registry.OpenKeyReadOnly( SKey ); 187 | Registry.GetKeyNames( Result ); 188 | // Registry.GetValueNames( Result ) ; 189 | // libRegistryCKey := Registry.CurrentKey; 190 | // libRegistrySPath := Registry.CurrentPath; 191 | Registry.HasSubKeys; 192 | Registry.Closekey; 193 | end; 194 | 195 | function RegistryReadString(const SKey : WideString, const IKey : Widestring) : WideString; 196 | Begin 197 | Result := ''; 198 | Registry.OpenKey(SKey, false); 199 | if Registry.ValueExists(IKey) then 200 | begin 201 | RegDataInfo := Registry.GetDataType(IKey); 202 | Result := Registry.ReadString(IKey); 203 | end; 204 | Registry.CloseKey; 205 | End; 206 | 207 | function RegistryReadKeyType(const SKey : WideString, const IKey : Widestring) : TRegDataInfo; 208 | Begin 209 | Result := rdUnknown; 210 | Registry.OpenKey(SKey, false); 211 | if Registry.ValueExists(IKey) then 212 | begin 213 | Result := Registry.GetDataType(IKey); 214 | end; 215 | Registry.CloseKey; 216 | End; 217 | 218 | -------------------------------------------------------------------------------- /System/InternalOptions.pas: -------------------------------------------------------------------------------- 1 | { InternalOptions.pas 2 | 3 | List all Internal Options for each/all installed AD... 4 | Internal Options == System Advanced Preferences settings. 5 | 6 | Reports all system Internal Options that are NOT set default. 7 | 8 | Creates an INI file per AD install with ALL Internal Options (System Advanced) 9 | 10 | 11 | BL Miller 12 | 2024-06-07 v0.10 POC from 2020 OptionIO & InstallSummary 13 | 14 | TBD: 15 | No 32 - 64 bit cross support.. 16 | If run from AD17 then ONLY 32bit registry is checked. 17 | If run from AD18+ then only 64bit installs are found. 18 | 19 | HKey_Local_Machine HKey_Current_User 20 | Registry.RootKey := HKEY_CURRENT_USER; 21 | 22 | // vv SpecialKey_SoftwareAltiumApp vv 23 | // HKEY_LOCAL_MACHINE/Software/Altium/Builds/Altium Designer {Fxxxxxxx-xxxxxxxxxxxxx}/*items 24 | // HKEY_CURRENT_USER/Software/Altium/Altium Designer {Fxxxxxxx-xxxxxxxxxxxxx}/DesignExplorer/Preferences 25 | } 26 | 27 | const 28 | { Reserved Key Handles. missing in DelphiScript} 29 | HKEY_CLASSES_ROOT = $80000000; 30 | HKEY_CURRENT_USER = $80000001; 31 | HKEY_LOCAL_MACHINE = $80000002; 32 | HKEY_USERS = $80000003; 33 | HKEY_PERFORMANCE_DATA = $80000004; 34 | HKEY_CURRENT_CONFIG = $80000005; 35 | HKEY_DYN_DATA = $80000006; 36 | 37 | cRegistrySubPath = '\Software\Altium\Builds'; // Machine installs 38 | cRegistrySubPath2 = '\Software\Altium'; // User prefs 39 | cRegistrySubPath3 = '\DesignExplorer\Preferences'; // User prefs 40 | 41 | // paralist of ItemKeys to report from Software\Altium\Builds\SpecialKey\.. 42 | csItemKeys = 'Application|Build|Display Name|ProgramsInstallPath|FullBuild|ReleaseDate|DocumentsInstallPath|Security|UniqueID|Version|Win64'; 43 | csReportPaths = 'ProgramsInstallPath|DocumentsInstallPath|Template Path|InstalledRelativePath'; 44 | 45 | // specific keys ..Software\Altium\SpecialKey\DesignExplorer\Preferences\ 46 | csItemKeys3 = 'InternalOptions'; 47 | 48 | // export 49 | cFilterFile = '_SysIntOpts.ini'; 50 | 51 | var 52 | Registry : TRegistry; 53 | RegDataInfo : TRegDataInfo; 54 | SectKeyList : TStringlist; 55 | SubSectList : TStringlist; 56 | ItemKeyList : TStringList; 57 | Report : TStringList; 58 | Project : IProject; 59 | FilePath : WideString; 60 | ReportDocument : IServerDocument; 61 | 62 | function RegistryReadString(const SKey : WideString, const IKey : Widestring) : WideString; forward; 63 | function RegistryReadInteger(const SKey : WideString, const IKey : Widestring) : WideString; forward; 64 | function RegistryReadSectKeys(const SKey : WideString, const ValueNName : boolean) : TStringList; forward; 65 | function RegistryReadKeyType(const SKey : WideString, const IKey : Widestring) : TRegDataInfo; forward; 66 | 67 | procedure ItemPathToSection (var SPath, var KPath : WideString); 68 | var 69 | pos : integer; 70 | begin 71 | SPath := SPath + '\' + ExtractFilePath(KPath); 72 | SPath := RemovePathSeparator(SPath); 73 | KPath := ExtractFileName(KPath); 74 | end; 75 | 76 | procedure ListInternalOptions; 77 | Var 78 | SectKey : WideString; 79 | SectKey2 : WideString; 80 | ItemKey : WideSting; 81 | ItemKey2 : WideSting; 82 | KeyValue : WideString; 83 | DirExists : WideString; 84 | IniFile : TIniFile; // do NOT use TIniFile for READING as strips quotes at each end! 85 | S, I, J : integer; 86 | Desc : WideString; 87 | Value : WideString; 88 | DefaultValue : WideString; 89 | 90 | begin 91 | 92 | Project := GetWorkSpace.DM_FocusedProject; 93 | FilePath := ExtractFilePath(Project.DM_ProjectFullPath); 94 | if (Project.DM_ProjectFullPath = 'Free Documents') or (FilePath = '') then 95 | FilePath := SpecialFolder_AllUserDocuments; // GetCurrentDir; 96 | 97 | Report := TStringList.Create; 98 | 99 | Registry := TRegistry.Create; // TRegistry.Create(KEY_WRITE OR KEY_WOW64_64KEY); KEY_SET_VALUE 100 | 101 | ItemKeyList := TStringList.Create; 102 | ItemKeyList.Delimiter := '|'; 103 | ItemKeyList.StrictDelimiter := true; 104 | ItemKeyList.DelimitedText := csItemKeys; 105 | 106 | Registry.RootKey := HKEY_LOCAL_MACHINE; 107 | // Registry.CurrentPath := HKEY_Root; // read only 108 | 109 | // do NOT include the RootKey Path 110 | SectKey := cRegistrySubPath; 111 | SectKeyList := RegistryReadSectKeys(SectKey, false); 112 | 113 | for S := 0 to (SectKeyList.Count - 1) do 114 | begin 115 | SectKey := SectkeyList.Strings(S); 116 | Report.Add('Section : ' + IntToStr(S) + ' ' + SectKey); 117 | for I := 0 to (ItemKeyList.Count - 1) do 118 | begin 119 | ItemKey := ItemKeyList.Strings(I); 120 | 121 | // don't forget the damn separator '\' 122 | RegDataInfo := RegistryReadKeyType(cRegistrySubPath + '\' + SectKey, ItemKey); 123 | // should check & handle other datatypes.. 124 | KeyValue := RegistryReadString(cRegistrySubPath + '\' + SectKey, ItemKey); 125 | 126 | DirExists := ''; 127 | if (ansipos(ItemKey, csReportpaths) > 0) then 128 | begin 129 | DirExists := 'path: NOT found'; 130 | if DirectoryExists(KeyValue) then 131 | DirExists := 'path: good'; 132 | end; 133 | 134 | Report.Add(PadRight(IntToStr(S) + '.' + IntToStr(I),4) + ' ' + PadRight(ItemKey,30) + ' = ' + PadRight(KeyValue,60) + ' datatype : ' +IntToStr(RegDataInfo) + ' ' + DirExists); 135 | end; 136 | Report.Add(''); 137 | end; 138 | 139 | ItemKeyList.Clear; 140 | 141 | // export the selected options from each install 142 | SubSectList := TStringList.Create; 143 | 144 | Registry.RootKey := HKEY_CURRENT_USER; 145 | 146 | for S := 0 to (SectKeyList.Count - 1) do 147 | begin 148 | SectKey := SectKeyList.Strings(S); 149 | Report.Add('Install Section : ' + IntToStr(S) + ' ' + SectKey); 150 | 151 | 152 | // get section keys (folders) for this install 153 | SectKey2 := cRegistrySubPath2 + '\' + SectKey + cRegistrySubPath3 + '\' + csItemKeys3; 154 | SubSectList := RegistryReadSectKeys(SectKey2, false); 155 | 156 | IniFile := TIniFile.Create(FilePath + '\' + SectKey + cFilterFile); 157 | 158 | 159 | for I := 0 to (SubSectList.Count - 1) do // ItemKeyList.Count - 1) do 160 | begin 161 | // don't forget the damn separator '\' 162 | SectKey2 := cRegistrySubPath2 + '\' + SectKey + cRegistrySubPath3 + '\' + csItemKeys3 + '\' + SubSectList.Strings(I); 163 | 164 | ItemKeyList := RegistryReadSectKeys(SectKey2, true); 165 | 166 | for J := 0 to (ItemKeyList.Count - 1) do 167 | begin 168 | ItemKey2 := Trim(ItemKeyList.Strings(J)); 169 | ItemPathToSection (SectKey2, ItemKey2); 170 | RegDataInfo := RegistryReadKeyType(SectKey2, ItemKey2); 171 | 172 | if RegDataInfo = rdInteger then 173 | KeyValue := RegistryReadInteger(SectKey2, ItemKey2) 174 | else 175 | KeyValue := RegistryReadString(SectKey2, ItemKey2); 176 | 177 | IniFile.WriteString(SubSectList.Strings(I), ItemKey2, KeyValue); 178 | end; 179 | 180 | RegDataInfo := RegistryReadKeyType(SectKey2, 'DefaultValue'); 181 | if RegDataInfo = rdInteger then 182 | DefaultValue := IntToStr(RegistryReadInteger(SectKey2, 'DefaultValue')) 183 | else 184 | DefaultValue := RegistryReadString(SectKey2, 'DefaultValue'); 185 | RegDataInfo := RegistryReadKeyType(SectKey2, 'Value'); 186 | if RegDataInfo = rdInteger then 187 | Value := IntToStr(RegistryReadInteger(SectKey2, 'Value')) 188 | else 189 | Value := RegistryReadString(SectKey2, 'Value'); 190 | 191 | Desc := RegistryReadString(SectKey2, 'Description'); 192 | 193 | if Value <> DefaultValue then 194 | Report.Add( SubSectList.Strings(I) + ' value:' + Value + ' desc:' +Desc); 195 | 196 | end; 197 | 198 | Report.Add(''); 199 | IniFile.UpdateFile; 200 | IniFile.Free; 201 | end; 202 | 203 | ItemKeyList.Free; 204 | 205 | // SectKeyList.Delimiter := #13; 206 | // SectKeyList.Insert(0,'List of installs : '); 207 | // ShowMessage(SectKeyList.DelimitedText); 208 | 209 | if Registry <> nil then Registry.Free; 210 | SectKeyList.Free; 211 | 212 | FilePath := FilePath + '\AD_SysIntOpts_Rep1.Txt'; 213 | Report.Insert(0, 'Report Altium System Internal Options (Advanced Prefs) in Registry'); 214 | Report.SaveToFile(FilePath); 215 | Report.Free; 216 | 217 | //Prj.DM_AddSourceDocument(FilePath); 218 | ReportDocument := Client.OpenDocument('Text', FilePath); 219 | 220 | If ReportDocument <> Nil Then 221 | begin 222 | Client.ShowDocument(ReportDocument); 223 | if (ReportDocument.GetIsShown <> 0 ) then 224 | ReportDocument.DoFileLoad; 225 | end; 226 | end; 227 | 228 | function RegistryReadSectKeys(const SKey : WideString, const ValueNName : boolean) : TStringList; 229 | var 230 | sTemp : TString; 231 | Begin 232 | sTemp := ''; 233 | Result := TStringList.Create; 234 | Registry.OpenKeyReadOnly( SKey ); 235 | 236 | if not ValueNName then 237 | Registry.GetKeyNames( Result ) 238 | else 239 | Registry.GetValueNames( Result ); 240 | // Result.Delimitedtext := sTemp; 241 | 242 | // libRegistryCKey := Registry.CurrentKey; 243 | // libRegistrySPath := Registry.CurrentPath; 244 | Registry.HasSubKeys; 245 | Registry.Closekey; 246 | end; 247 | 248 | function RegistryReadString(const SKey : WideString, const IKey : Widestring) : WideString; 249 | Begin 250 | Result := ''; 251 | Registry.OpenKey(SKey, false); 252 | if Registry.ValueExists(IKey) then 253 | begin 254 | RegDataInfo := Registry.GetDataType(IKey); 255 | Result := Registry.ReadString(IKey); 256 | end; 257 | Registry.CloseKey; 258 | End; 259 | 260 | function RegistryReadInteger(const SKey : WideString, const IKey : Widestring) : WideString; 261 | Begin 262 | Result := 0; 263 | Registry.OpenKey(SKey, false); 264 | if Registry.ValueExists(IKey) then 265 | begin 266 | RegDataInfo := Registry.GetDataType(IKey); 267 | Result := Registry.ReadInteger(IKey); 268 | end; 269 | Registry.CloseKey; 270 | End; 271 | 272 | function RegistryReadKeyType(const SKey : WideString, const IKey : Widestring) : TRegDataInfo; 273 | Begin 274 | Result := rdUnknown; 275 | Registry.OpenKey(SKey, false); 276 | if Registry.ValueExists(IKey) then 277 | begin 278 | Result := Registry.GetDataType(IKey); 279 | end; 280 | Registry.CloseKey; 281 | End; 282 | 283 | -------------------------------------------------------------------------------- /System/PCBLayerOrder.pas: -------------------------------------------------------------------------------- 1 | { PCBLayerOrder.pas 2 | 3 | 4 | Works on current running Altium Registry path. 5 | Export AdvPCB server settings from Registry to an ini-file 6 | Import from an user ini-file to the server preferences in Registry. 7 | 8 | If this is run before opening ANY PcbDoc then do not have to restart. 9 | 10 | May have to close & re-open Altium to refresh Layer drawing order. 11 | 12 | can use IOptionsReader/Writer or IRegistry interfaces to R/W the registry. 13 | Both work, both appear to do same thing. 14 | IRegistry interface not fully utilised. 15 | 16 | Note: 17 | Import loading to server seems pointless as servers can not be made to refresh. 18 | 19 | B.L Miller 20 | 19/08/2022 v0.11 POC 21 | 22 | IOptionsWriter methods IOptionsWriter properties 23 | EraseSection 24 | WriteBoolean 25 | WriteDouble 26 | WriteInteger 27 | WriteString 28 | 29 | IOptionsReader methods IOptionsReader properties 30 | ReadBoolean 31 | ReadDouble 32 | ReadInteger 33 | ReadString 34 | ReadSection 35 | SectionExists 36 | ValueExists 37 | 38 | IOptionsManager methods IOptionsManager properties 39 | GetOptionsReader 40 | GetOptionsWriter 41 | OptionsExist 42 | 43 | MAJOR weakness with above is determining the correct data type. Big problem! 44 | 45 | IRegistry // many parallel functions to OptionReader/Writer but more flexible. 46 | IDocumentOptionsSet // interesting, but does not seem useful. 47 | } 48 | 49 | // Registry paths & special keys. 50 | // vv SpecialKey_SoftwareAltiumApp vv 51 | // HKEY_CURRENT_USER/Software/Altium/Altium Designer {FB13163A-xxxxxxxxxxxxx}/DesignExplorer/Preferences 52 | 53 | const 54 | cRegistrySubPath = '\DesignExplorer\Preferences\'; // registry path to prefs from AD-install root. 55 | 56 | cNameOfServer = 'AdvPCB'; 57 | // cSectionNamesExport = 'SystemOptions|BoardReportOptions|ReportOptions'; 58 | cSectionNamesExport = 'SystemOptions'; 59 | cSectionNamesImport = 'SystemOptions'; 60 | cKeyPatterns = 'LayerDrawingOrder'; // subset of pattern matched Keys to process. integer 61 | 62 | var 63 | SectionNames : TStringList; 64 | SectKeys : TStringList; 65 | KeyPatterns : TStringList; 66 | 67 | Report : TStringList; 68 | ReportDoc : IServerDocument; 69 | AValue : WideString; 70 | Flag : Integer; 71 | Filename : WideString; 72 | ViewState : WideString; 73 | 74 | function RegistryWriteString(const SKey : Widestring, const IKey : WideString, const IVal : WideString) : boolean; 75 | var 76 | Registry : TRegistry; 77 | Begin 78 | Result := false; 79 | Registry := TRegistry.Create; 80 | Try 81 | Registry.OpenKey(SKey, true); 82 | if Registry.ValueExists(IKey) then 83 | Result := true; // Registry.ReadString(IKey); 84 | // rdString 85 | Registry.WriteString(IKey, IVal); 86 | Registry.CloseKey; 87 | 88 | Finally 89 | Registry.Free; 90 | End; 91 | End; 92 | 93 | function RegistryWriteInteger(const SKey : Widestring, const IKey : WideString, const IVal : Integer) : boolean; 94 | var 95 | Registry : TRegistry; 96 | RegDataInfo : TRegDataInfo; 97 | Begin 98 | Result := false; 99 | Registry := TRegistry.Create; 100 | Try 101 | Registry.OpenKey(SKey, true); 102 | if Registry.ValueExists(IKey) then 103 | begin 104 | RegDataInfo := Registry.GetDataType(IKey); 105 | if RegDataInfo = rdInteger then 106 | begin 107 | Registry.WriteInteger(IKey, IVal); 108 | Result := true; 109 | end; 110 | end; 111 | Registry.CloseKey; 112 | Finally 113 | Registry.Free; 114 | End; 115 | End; 116 | 117 | procedure ImportLayerOrder; 118 | Var 119 | OpenDialog : TOpenDialog; 120 | Reader : IOptionsReader; 121 | Writer : IOptionsWriter; 122 | IniFile : TMemIniFile; // do NOT use TIniFile for READING as strips quotes at each end! 123 | I : integer; 124 | OptionsMan : IOptionsManager; 125 | SectName : WideString; 126 | KeyName : WideString; 127 | KeyValue : WideString; 128 | intValue : Integer; 129 | RegSectKey : WideString; 130 | RegItemKey : WideString; 131 | Button : WideString; 132 | bSuccess : boolean; 133 | 134 | Begin 135 | OptionsMan := Client.OptionsManager; 136 | 137 | Writer := OptionsMan.GetOptionsWriter(cNameOfServer); 138 | Reader := OptionsMan.GetOptionsReader(cNameOfServer,''); 139 | 140 | If (Writer = nil) or (Reader = nil) Then 141 | begin 142 | // ShowMessage('no options found '); 143 | Exit; 144 | end; 145 | 146 | OpenDialog := TOpenDialog.Create(Application); 147 | OpenDialog.Title := 'Import ' + cNameOfServer + '_' + cSectionNamesImport + ' *.ini file'; 148 | OpenDialog.Filter := 'INI file (*.ini)|*.ini'; 149 | // OpenDialog.InitialDir := ExtractFilePath(Board.FileName); 150 | OpenDialog.FileName := cNameOfServer + '_' + cSectionNamesImport + '*.ini'; 151 | Flag := OpenDialog.Execute; 152 | if (Flag = 0) then exit; 153 | FileName := OpenDialog.FileName; 154 | IniFile := TMemIniFile.Create(FileName); 155 | 156 | SectName := cSectionNamesImport; 157 | 158 | SectKeys := TStringList.Create; 159 | SectKeys.Delimiter := '='; 160 | SectKeys.StrictDelimiter := true; 161 | // SectKeys.NameValueSeparator := '='; 162 | 163 | if OptionsMan.OptionsExist(cNameOfServer,'') then 164 | begin 165 | Client.ArePreferencesReadOnly(cNameOfserver, SectName); 166 | 167 | if IniFile.SectionExists(SectName) then 168 | if Reader.SectionExists(SectName) then 169 | begin 170 | IniFile.ReadSectionValues(SectName, SectKeys); 171 | 172 | for I := 0 to (SectKeys.Count - 1) do 173 | begin 174 | KeyName := SectKeys.Names(I); 175 | KeyValue := SectKeys.ValueFromIndex(I); 176 | 177 | // hex or int string to int & sanitise 178 | if KeyValue = '' then KeyValue :='0'; 179 | intValue := StrToInt(KeyValue); 180 | if (IntValue < 0) then IntValue := 0; 181 | // if (IntValue > $FFFFFF) then IntValue := $FFFFFF; 182 | 183 | // write to Server Options 184 | Writer.WriteInteger(SectName, KeyName, IntValue); 185 | // write to Registry 186 | RegSectKey := SpecialKey_SoftwareAltiumApp + cRegistrySubPath + cNameOfServer + '\' + SectName; 187 | bSuccess := RegistryWriteInteger(RegSectKey, KeyName, IntValue); 188 | end; 189 | end 190 | else 191 | ShowMessage('server does not have this section ' + SectName); 192 | 193 | SectKeys.Clear; 194 | end; 195 | 196 | Reader := nil; 197 | Writer := nil; 198 | IniFile.Free; 199 | 200 | client.SetPreferencesChanged(true); 201 | Client.GUIManager.UpdateInterfaceState; 202 | 203 | bSuccess := false; 204 | if not bSuccess then 205 | ShowMessage('Close & reopen Altium to get layer order, sorry..'); 206 | End; 207 | 208 | procedure ExportLayerOrder; 209 | Var 210 | // FileName : String; 211 | SaveDialog : TSaveDialog; 212 | Reader : IOptionsReader; // TRegistryReader 213 | Reader2 : IOptionsReader; 214 | IniFile : TIniFile; // do NOT use TIniFile for READING as strips quotes at each end! 215 | SectName : WideString; 216 | I, J : integer; 217 | KeyName : WideString; 218 | dblValue : TExtended; 219 | intValue : Integer; 220 | Datatype : Widestring; 221 | Match : boolean; 222 | 223 | Begin 224 | Reader := Client.OptionsManager.GetOptionsReader(cNameOfServer, ''); 225 | 226 | If Reader = Nil Then 227 | begin 228 | ShowMessage('no options found '); 229 | Exit; 230 | end; 231 | 232 | SaveDialog := TSaveDialog.Create(Application); 233 | SaveDialog.Title := 'Export ' + cNameOfServer + '_' + cSectionNamesExport + ' *.ini file'; 234 | SaveDialog.Filter := 'INI file (*.ini)|*.ini'; 235 | FileName := cNameOfServer + '_' + cSectionNamesExport + '.ini'; 236 | SaveDialog.FileName := FileName; 237 | 238 | Flag := SaveDialog.Execute; 239 | if (Flag = 0) then exit; 240 | 241 | Report := TStringList.Create; 242 | 243 | // Get file & set extension 244 | FileName := SaveDialog.FileName; 245 | FileName := ChangeFileExt(FileName, '.ini'); 246 | IniFile := TIniFile.Create(FileName); 247 | 248 | SectName := cSectionNamesExport; // load from const 249 | 250 | SectKeys := TStringList.Create; 251 | SectKeys.Delimiter := #13; 252 | SectKeys.StrictDelimiter := true; 253 | // SectKeys.NameValueSeparator := '='; 254 | 255 | KeyPatterns := TStringList.Create; 256 | KeyPatterns.Delimiter := '|'; 257 | KeyPatterns.StrictDelimiter := true; 258 | KeyPatterns.DelimitedText := cKeyPatterns; 259 | 260 | Filename := ''; 261 | ReportDoc := nil; 262 | Report.Add(SpecialKey_SoftwareAltiumApp); 263 | Report.Add(cNameOfServer); 264 | 265 | if Reader.SectionExists(SectName) then 266 | begin 267 | AValue := Reader.ReadSection(SectName); 268 | SectKeys.DelimitedText := AValue; 269 | Report.Add(SectName + ' option count : ' + IntToStr(SectKeys.Count)); 270 | 271 | for I := 0 to (SectKeys.Count - 1) do 272 | begin 273 | KeyName := trim(SectKeys.Strings(I)); // need to trim to find it! 274 | 275 | Match := false; 276 | for J := 0 to (KeyPatterns.Count - 1) do 277 | begin 278 | if (ansipos(KeyPatterns.Strings(J), KeyName) > 0) then 279 | Match := true; 280 | end; 281 | if not Match then continue; 282 | 283 | intValue := 0; 284 | if Reader.ValueExists(SectName, KeyName) then 285 | begin 286 | // registry key value is DWord integer 287 | intValue := Reader.ReadInteger(SectName, KeyName, 0); 288 | 289 | IniFile.WriteInteger(SectName, KeyName, intValue); 290 | end; 291 | 292 | Report.Add(IntToStr(I) + ' ' + PadRight(KeyName, 45) + ' = ' + IntToStr(intValue) ); 293 | end; 294 | 295 | // IniFile.WriteString('Comment', 'DataFormat', 'int'); 296 | Report.Add(''); 297 | 298 | end else 299 | ShowMessage('section ' + SectName + ' not found'); 300 | 301 | Filename := SpecialFolder_TemporarySlash + cNameOfServer + '-PCBLayerOrder-ExportReport.txt'; 302 | Report.SaveToFile(Filename); 303 | 304 | SectKeys.Free; 305 | Report.Free; 306 | IniFile.Free; 307 | 308 | if FileName <> '' then 309 | ReportDoc := Client.OpenDocument('Text', FileName); 310 | If ReportDoc <> Nil Then 311 | begin 312 | Client.ShowDocument(ReportDoc); 313 | if (ReportDoc.GetIsShown <> 0 ) then 314 | ReportDoc.DoFileLoad; 315 | end; 316 | end; 317 | 318 | -------------------------------------------------------------------------------- /System/Zipper-example.pas: -------------------------------------------------------------------------------- 1 | { Zipper-example.pas 2 | 3 | tbd: could just use 4 | CreateZipFile(AZipFileName, FileList, bPreservePaths); 5 | } 6 | 7 | procedure TestZipper; 8 | var 9 | Zip : TXceedZip; 10 | PrjFileName : string; 11 | ZipFileName : string; 12 | ProjectPath : string; 13 | GeneratedFiles : TStringList; 14 | FilePath : WideString; 15 | I : Integer; 16 | begin 17 | 18 | ZipFileName := 'C:\Altium\TestZip.ZIP'; 19 | ProjectPath := 'C:\Altium\TestZIP\'; 20 | 21 | Zip := TXCeedZip.Create(ZipFileName); 22 | 23 | // Setup Zipper, dont want to generate a temporary folder/file 24 | Zip.UseTempFile := False; 25 | Zip.BasePath := RemoveSlash(ProjectPath, cPathSeparator); 26 | 27 | // can use FindFiles(subfolders=true) and/or ProcessSubFolders=true. 28 | Zip.ProcessSubfolders := false; 29 | 30 | GeneratedFiles := TStringList.Create; 31 | // FileFiles() returns filenames in UPPERCASE. 32 | FindFiles(ProjectPath, '*.*', faAnyFile, true, GeneratedFiles); 33 | 34 | // This returns correct case & not '.' or '..' files. So file count is meaningful. 35 | GeneratedFiles.Clear; 36 | GetAllFilePathsMatchingMask(GeneratedFiles, ProjectPath, '*.*', true); 37 | 38 | If GeneratedFiles.Count > 0 Then 39 | For I := 0 to GeneratedFiles.Count - 1 Do 40 | begin 41 | FilePath := GeneratedFiles.Strings[I]; 42 | 43 | // require relative path for files & subfolders. 44 | FilePath := ExtractRelativePath(ProjectPath, FilePath); 45 | 46 | // FileFiles() cleanup, not really required & does not handle subfolders. 47 | if (FilePath = cFilename_CurrentDir) or (FilePath = cFilename_ParentDir) then 48 | continue; 49 | 50 | Zip.AddFilesToProcess(FilePath); 51 | end; 52 | 53 | I := Zip.Zip; 54 | 55 | GeneratedFiles.Free; 56 | // Zip.CompressionLevel; 57 | Zip.InstanceSize; 58 | ShowMessage('.Zip returns: ' + IntToStr(I) + ' size:' + IntToStr(Zip.InstanceSize) ); // + ' compress:' + IntToStr(Zip.CompressionLevel)); 59 | Zip.Free; 60 | end; 61 | -------------------------------------------------------------------------------- /System/dummy.txt: -------------------------------------------------------------------------------- 1 | dummy file to create a folder for a file upload in silly web UI 2 | --------------------------------------------------------------------------------