aboutsummaryrefslogtreecommitdiffstats
path: root/EE3102/Libraries/InstrumentAmp/UL_Import.pas
diff options
context:
space:
mode:
Diffstat (limited to 'EE3102/Libraries/InstrumentAmp/UL_Import.pas')
-rw-r--r--EE3102/Libraries/InstrumentAmp/UL_Import.pas1081
1 files changed, 0 insertions, 1081 deletions
diff --git a/EE3102/Libraries/InstrumentAmp/UL_Import.pas b/EE3102/Libraries/InstrumentAmp/UL_Import.pas
deleted file mode 100644
index fd9b912..0000000
--- a/EE3102/Libraries/InstrumentAmp/UL_Import.pas
+++ /dev/null
@@ -1,1081 +0,0 @@
-
-const ForceSchFontID = 1;
-
-var
- BrokenSCHFontManager : Integer; // for Alitum 19's broken SCH FontManager
-
-{==============================================================================}
-{==== String Utility Routines ===============================================}
-{==============================================================================}
-
-Function CheckLeft(BaseStr: String, Srch: String): Boolean;
-Var
- i : Integer;
-Begin
- Result := False;
- i := Length(Srch);
- If Length(BaseStr) < i Then Exit;
- If Copy(BaseStr, 1, i) = Srch Then Result := True;
-End;
-
-Function LeftOf(BaseStr: String, Srch: String): String;
-Var
- i : Integer;
-Begin
- i := Pos(Srch, BaseStr);
- If i > 0 Then Begin
- Result := Copy(BaseStr, 1, i - 1);
- End Else Begin
- Result := BaseStr;
- End;
-End;
-
-Function LeftOfLast(BaseStr: String, Srch: String): String;
-Var
- i, ls : Integer;
- lft, rgt : String;
-Begin
- rgt := BaseStr;
- i := Pos(Srch, rgt);
- lft := '';
- If i > 0 Then Begin
- ls := Length(Srch);
- While i > 0 Do Begin
- lft := lft + Copy(rgt, 1, i - 1);
- rgt := Copy(rgt, i + ls, Length(rgt) - i + ls);
- i := Pos(Srch, rgt);
- If i > 0 then Begin
- lft := lft + Srch;
- End;
- End;
- Result := lft;
- End Else Begin
- Result := BaseStr;
- End;
-End;
-
-Function RightOf(BaseStr: String, Srch: String): String;
-Var
- i, ls : Integer;
-Begin
- i := Pos(Srch, BaseStr);
- If i > 0 Then Begin
- ls := Length(Srch);
- Result := Copy(BaseStr, i + ls, Length(BaseStr) - i + ls);
- End Else Begin
- Result := '';
- End;
-End;
-
-Procedure StrChop(BaseStr: String, Srch: String, Out LeftSide: String, Out RightSide: String);
-Var
- i, ls : Integer;
-Begin
- i := Pos(Srch, BaseStr);
- If i <= 0 Then Begin
- LeftSide := BaseStr;
- RightSide := '';
- End Else Begin
- ls := Length(Srch);
- LeftSide := Copy(BaseStr, 1, i - 1);
- RightSide := Copy(BaseStr, i + ls, Length(BaseStr) - i + ls);
- End;
-End;
-
-Function GetBetween(BaseStr: String, StartStr: String, EndStr: String): String;
-Begin
- Result := Leftof(RightOf(BaseStr, StartStr), EndStr);
-End;
-
-Function GetFileLocation(FilePath: String): String;
-Var
- i : Integer;
- filename : String;
-Begin
- filename := RightOf(FilePath, '\');
- i := Pos('\', filename);
- While i > 0 Do Begin
- filename := RightOf(filename, '\');
- i := Pos('\', filename);
- End;
- Result := LeftOf(Filepath, filename);
-End;
-
-{==============================================================================}
-{==== Footprint Routines ====================================================}
-{==============================================================================}
-
-Function LayerFromString(LName: String): TLayer;
-Begin
- Case LName Of
- 'NoLayer': Result := eNoLayer;
- 'TopLayer': Result := eTopLayer;
- 'MidLayer1': Result := eMidLayer1;
- 'MidLayer2': Result := eMidLayer2;
- 'MidLayer3': Result := eMidLayer3;
- 'MidLayer4': Result := eMidLayer4;
- 'MidLayer5': Result := eMidLayer5;
- 'MidLayer6': Result := eMidLayer6;
- 'MidLayer7': Result := eMidLayer7;
- 'MidLayer8': Result := eMidLayer8;
- 'MidLayer9': Result := eMidLayer9;
- 'MidLayer10': Result := eMidLayer10;
- 'MidLayer11': Result := eMidLayer11;
- 'MidLayer12': Result := eMidLayer12;
- 'MidLayer13': Result := eMidLayer13;
- 'MidLayer14': Result := eMidLayer14;
- 'MidLayer15': Result := eMidLayer15;
- 'MidLayer16': Result := eMidLayer16;
- 'MidLayer17': Result := eMidLayer17;
- 'MidLayer18': Result := eMidLayer18;
- 'MidLayer19': Result := eMidLayer19;
- 'MidLayer20': Result := eMidLayer20;
- 'MidLayer21': Result := eMidLayer21;
- 'MidLayer22': Result := eMidLayer22;
- 'MidLayer23': Result := eMidLayer23;
- 'MidLayer24': Result := eMidLayer24;
- 'MidLayer25': Result := eMidLayer25;
- 'MidLayer26': Result := eMidLayer26;
- 'MidLayer27': Result := eMidLayer27;
- 'MidLayer28': Result := eMidLayer28;
- 'MidLayer29': Result := eMidLayer29;
- 'MidLayer30': Result := eMidLayer30;
- 'BottomLayer': Result := eBottomLayer;
- 'TopOverlay': Result := eTopOverlay;
- 'BottomOverlay': Result := eBottomOverlay;
- 'TopPaste': Result := eTopPaste;
- 'BottomPaste': Result := eBottomPaste;
- 'TopSolder': Result := eTopSolder;
- 'BottomSolder': Result := eBottomSolder;
- 'InternalPlane1': Result := eInternalPlane1;
- 'InternalPlane2': Result := eInternalPlane2;
- 'InternalPlane3': Result := eInternalPlane3;
- 'InternalPlane4': Result := eInternalPlane4;
- 'InternalPlane5': Result := eInternalPlane5;
- 'InternalPlane6': Result := eInternalPlane6;
- 'InternalPlane7': Result := eInternalPlane7;
- 'InternalPlane8': Result := eInternalPlane8;
- 'InternalPlane9': Result := eInternalPlane9;
- 'InternalPlane10': Result := eInternalPlane10;
- 'InternalPlane11': Result := eInternalPlane11;
- 'InternalPlane12': Result := eInternalPlane12;
- 'InternalPlane13': Result := eInternalPlane13;
- 'InternalPlane14': Result := eInternalPlane14;
- 'InternalPlane15': Result := eInternalPlane15;
- 'InternalPlane16': Result := eInternalPlane16;
- 'DrillGuide': Result := eDrillGuide;
- 'KeepOutLayer': Result := eKeepOutLayer;
- 'Mechanical1': Result := eMechanical1;
- 'Mechanical2': Result := eMechanical2;
- 'Mechanical3': Result := eMechanical3;
- 'Mechanical4': Result := eMechanical4;
- 'Mechanical5': Result := eMechanical5;
- 'Mechanical6': Result := eMechanical6;
- 'Mechanical7': Result := eMechanical7;
- 'Mechanical8': Result := eMechanical8;
- 'Mechanical9': Result := eMechanical9;
- 'Mechanical10': Result := eMechanical10;
- 'Mechanical11': Result := eMechanical11;
- 'Mechanical12': Result := eMechanical12;
- 'Mechanical13': Result := eMechanical13;
- 'Mechanical14': Result := eMechanical14;
- 'Mechanical15': Result := eMechanical15;
- 'Mechanical16': Result := eMechanical16;
- 'DrillDrawing': Result := eDrillDrawing;
- 'MultiLayer': Result := eMultiLayer;
- 'ConnectLayer': Result := eConnectLayer;
- 'BackGroundLayer': Result := eBackGroundLayer;
- 'DRCErrorLayer': Result := eDRCErrorLayer;
- 'HighlightLayer': Result := eHighlightLayer;
- 'GridColor1': Result := eGridColor1;
- 'GridColor10': Result := eGridColor10;
- 'PadHoleLayer': Result := ePadHoleLayer;
- 'ViaHoleLayer': Result := eViaHoleLayer;
- Else
- Result := eNoLayer;
- End;
-End;
-
-
-Procedure FP_AddStep(fp: IPCB_LibComponent, Data: String, InFileName: String);
-Var
- STEPFileName : String;
- STEPmodel : IPCB_ComponentBody;
- Model : IPCB_Model;
-Begin
- STEPFileName := GetFileLocation(InFileName) + '\' + GetBetween(Data, '(Name ', ')');
- STEPmodel := PcbServer.PCBObjectFactory(eComponentBodyObject,eNoDimension,eCreate_Default);
- Model := STEPmodel.ModelFactory_FromFilename(STEPFileName, false);
- STEPmodel.SetState_FromModel;
- // Model.SetState(0,0,0,0);
- STEPmodel.Model := Model;
- fp.AddPCBObject(STEPmodel);
- //PCBServer.SendMessageToRobots(fp.I_ObjectAddress, c_Broadcast, PCBM_BoardRegisteration, arc.I_ObjectAddress);
-End;
-
-Procedure FP_AddLine(fp: IPCB_Component, Data: String);
-Var
- lin : IPCB_track;
- s1, s2 : String;
-Begin
- lin := PCBServer.PCBObjectFactory(eTrackObject, eNoDimension, eCreate_Default);
- If lin = Nil Then Exit;
- StrChop(GetBetween(Data, '(Start ', ')'), ',', s1, s2);
- lin.X1 := MilsToCoord(Evaluate(s1));
- lin.Y1 := MilsToCoord(Evaluate(s2));
- StrChop(GetBetween(Data, '(End ', ')'), ',', s1, s2);
- lin.X2 := MilsToCoord(Evaluate(s1));
- lin.Y2 := MilsToCoord(Evaluate(s2));
- lin.Layer := LayerFromString(GetBetween(Data, '(Layer ', ')'));
- lin.Width := MilsToCoord(Evaluate(GetBetween(Data, '(Width ', ')')));
- fp.AddPCBObject(lin);
- PCBServer.SendMessageToRobots(fp.I_ObjectAddress, c_Broadcast, PCBM_BoardRegisteration, lin.I_ObjectAddress);
-End;
-
-Procedure FP_AddArc(fp: IPCB_Component, Data: String);
-Var
- arc : IPCB_Arc;
- s1, s2 : String;
-Begin
- arc := PCBServer.PCBObjectFactory(eArcObject, eNoDimension, eCreate_Default);
- If arc = Nil Then Exit;
- StrChop(GetBetween(Data, '(Location ', ')'), ',', s1, s2);
- arc.XCenter := MilsToCoord(Evaluate(s1));
- arc.YCenter := MilsToCoord(Evaluate(s2));
- arc.Radius := MilsToCoord(Evaluate(GetBetween(Data, '(Radius ', ')')));
- arc.LineWidth := MilsToCoord(Evaluate(GetBetween(Data, '(Width ', ')')));
- arc.StartAngle := Evaluate(GetBetween(Data, '(StartAngle ', ')'));
- arc.EndAngle := Evaluate(GetBetween(Data, '(EndAngle ', ')'));
- arc.Layer := LayerFromString(GetBetween(Data, '(Layer ', ')'));;
- fp.AddPCBObject(arc);
- PCBServer.SendMessageToRobots(fp.I_ObjectAddress, c_Broadcast, PCBM_BoardRegisteration, arc.I_ObjectAddress);
-End;
-
-Procedure FP_AddPoly(fp: IPCB_Component, Data: String, InFile: TextFile);
-Var
- pol : IPCB_Region;
- cont : IPCB_Contour;
- pc: Integer;
- s1, s2, inp, tag : String;
-Begin
- pol := PCBServer.PCBObjectFactory(eRegionObject, eNoDimension,eCreate_Default);
- If pol = Nil Then Exit;
- cont := pol.MainContour.Replicate();
- pol.Layer := LayerFromString(GetBetween(Data, '(Layer ', ')'));
- cont.Count := Evaluate(GetBetween(Data, '(PointCount ', ')'));
- pc := 0;
- While Not EOF(InFile) Do Begin
- ReadLn(InFile, inp);
- If VarIsNull(inp) Then Continue;
- inp := Trim(inp);
- StrChop(inp, ' ', tag, inp);
- tag := Trim(tag);
- Case tag Of
- 'Point': Begin
- pc := pc + 1;
- StrChop(GetBetween(inp, '(', ')'), ',', s1, s2);
- cont.X[pc] := MilsToCoord(Evaluate(s1));
- cont.Y[pc] := MilsToCoord(Evaluate(s2));
- End;
- 'EndPolygon': Break;
- Else Begin
- ShowMessage('Keyword Error: ' + tag);
- End;
- End;
- End;
- pol.SetOutlineContour(cont);
- If GetBetween(Data, '(Type ', ')') = 'KeepOut' Then Begin
- pol.IsKeepout := True;
- End;
- fp.AddPCBObject(pol);
- PCBServer.SendMessageToRobots(fp.I_ObjectAddress, c_Broadcast, PCBM_BoardRegisteration, pol.I_ObjectAddress);
-End;
-
-Procedure FP_AddText(fp: IPCB_Component, Data: STring);
-Var
- txt : IPCB_Text;
- s1, s2 : String;
-Begin
- txt := PCBServer.PCBObjectFactory(eTextObject, eNoDimension, eCreate_Default);
- If txt = Nil Then Exit;
- StrChop(GetBetween(Data, '(Location ', ')'), ',', s1, s2);
- txt.XLocation := MilsToCoord(Evaluate(s1));
- txt.YLocation := MilsToCoord(Evaluate(s2));
- txt.Layer := LayerFromString(GetBetween(Data, '(Layer ', ')'));
- txt.Size := MilsToCoord(Evaluate(GetBetween(Data, '(Height ', ')')));
- txt.Width := MilsToCoord(Evaluate(GetBetween(Data, '(Width ', ')')));
- If GetBetween(Data, '(Mirrored ', ')') = 'True' Then Begin
- txt.MirrorFlag := True;
- End;
- txt.Rotation := Evaluate(GetBetween(Data, '(Rotation ', ')'));
- txt.Text := GetBetween(Data, '(Value "', '")');
- // Justification? NOTE: TODO:
- fp.AddPCBObject(txt);
- PCBServer.SendMessageToRobots(fp.I_ObjectAddress, c_Broadcast, PCBM_BoardRegisteration, txt.I_ObjectAddress);
-End;
-
-Procedure FP_AddPad(fp: IPCB_Component, Data: String, InFile: TextFile);
-Var
- s1, s2, inp, tag, lay : String;
- pad : IPCB_Pad;
- padsh : TShape;
- cache : TPadCache;
-Begin
- pad := PcbServer.PCBObjectFactory(ePadObject, eNoDimension, eCreate_Default);
- pad.Name := GetBetween(Data, '(Name "', '")');
-// pad.Layer := LayerFromString(GetBetween(Data, '(Layer ', ')'));
- StrChop(GetBetween(Data, '(Location ', ')'), ',', s1, s2);
- pad.X := MilsToCoord(Evaluate(s1));
- pad.Y := MilsToCoord(Evaluate(s2));
- pad.Rotation := Evaluate(GetBetween(Data, '(Rotation ', ')')); // 2010-07-06 gbn
-// pad.Mode := ePadMode_LocalStack; // ePadMode_Simple, ePadMode_ExternalStack
- s1 := GetBetween(Data, '(ExpandPaste ', ')');
- s2 := GetBetween(Data, '(ExpandMask ', ')');
- If s1 <> '' || s2 <> '' Then Begin
- cache := pad.Cache;
- If s1 <> '' Then Begin
- cache.PasteMaskExpansionValid := eCacheManual;
- cache.PasteMaskExpansion := MilsToCoord(Evaluate(s1));
- End;
- If s2 <> '' Then Begin
- cache.SolderMaskExpansionValid := eCacheManual;
- cache.SolderMaskExpansion := MilsToCoord(Evaluate(s2));
- End;
- pad.Cache := cache;
- End;
- If GetBetween(Data, '(Surface ', ')') = 'True' Then Begin
- pad.Mode := ePadMode_Simple;
- pad.Layer := eTopLayer;
- End Else Begin
- pad.Mode := ePadMode_LocalStack;
- End;
- pad.Moveable := False;
- pad.HoleType := eRoundHole; // eSquareHole, eSlotHole
- pad.HoleSize := MilsToCoord(Evaluate(GetBetween(Data, '(HoleSize ', ')')));
- //2020-11-18 JRR Start; Let's set the Plated value, if present
- If GetBetween(Data, '(Plated ', ')') <> '' Then Begin
- pad.Plated := (GetBetween(Data, '(Plated ', ')')='True');
- End;
- //2020-11-18 JRR End
- While Not EOF(InFile) Do Begin
- ReadLn(InFile, inp);
- If VarIsNull(inp) Then Continue;
- inp := Trim(inp);
- StrChop(inp, ' ', tag, inp);
- tag := Trim(tag);
- Case tag Of
- 'PadShape': Begin
- padsh := eNoShape;
- StrChop(GetBetween(inp, '(Size ', ')'), ',', s1, s2);
- Case GetBetween(inp, '(Shape ', ')') Of
- 'NoShape': padsh := eNoShape;
- 'Rounded': padsh := eRounded;
- 'Rectangular': padsh := eRectangular;
- 'Octagonal': padsh := eOctagonal;
- 'CircleShape': padsh := eCircleShape;
- 'ArcShape': padsh := eArcShape;
- 'Terminator': padsh := eTerminator;
- 'RoundedRectangle': padsh := eRoundedRectangular;
- 'RotatedRectangle': padsh := eRotatedRectShape;
- Else padsh := eNoShape;
- End;
- lay := GetBetween(inp, '(Layer ', ')');
- If CheckLeft(lay, 'Top') Then Begin
- pad.TopShape := padsh;
- pad.TopXSize := MilsToCoord(Evaluate(s1));
- pad.TopYSize := MilsToCoord(Evaluate(s2));
- End Else If CheckLeft(lay, 'Mid') Then Begin
- pad.MidShape := padsh;
- pad.MidXSize := MilsToCoord(Evaluate(s1));
- pad.MidYSize := MilsToCoord(Evaluate(s2));
- End Else If CheckLeft(lay, 'Bot') Then Begin
- pad.BotShape := padsh;
- pad.BotXSize := MilsToCoord(Evaluate(s1));
- pad.BotYSize := MilsToCoord(Evaluate(s2));
- End;
- End;
- 'EndPad': Begin
- Break;
- End;
- Else Begin
- ShowMessage('Keyword Error: ' + tag);
- End;
- End;
- End;
- fp.AddPCBObject(pad);
- PCBServer.SendMessageToRobots(fp.I_ObjectAddress, c_Broadcast, PCBM_BoardRegisteration, pad.I_ObjectAddress);
-End;
-
-Procedure ImportFootprints(InFile: TextFile, Lib: IPCB_Library, Errors: TStringList, InFileName : String);
-Var
- inp, tag, s, t : String;
- fp : IPCB_Component;
-Begin
- While Not EOF(InFile) Do Begin
- ReadLn(InFile, inp);
- If VarIsNull(inp) Then Continue;
- inp := Trim(inp);
-
- StrChop(inp, ' ', tag, inp);
- tag := Trim(tag);
- Case tag Of
- 'Footprint': Begin
- // create a footprint reference
- fp := PCBServer.CreatePCBLibComp();
- If fp = Nil Then Begin
- Errors.Add('Error creating footprint.');
- Break;
- End;
- // add data to it
- fp.Name := GetBetween(inp, '(Name "', '")');
- // assign it to library
- Lib.RegisterComponent(fp);
- PCBServer.PreProcess();
- // add data to it
- fp.BeginModify();
- // set height
- t := GetBetween(inp, '(Height ', ')');
- If t <> '' Then Begin
- fp.Height := MilsToCoord(Evaluate(t));
- End;
-
- While Not EOF(InFile) Do Begin
- ReadLn(InFile, inp);
- If VarIsNull(inp) Then Continue;
- inp := Trim(inp);
- If CheckLeft(inp, '#') Then Continue;
-
- StrChop(inp, ' ', tag, inp);
- tag := Trim(tag);
- Case tag Of
- 'Pad': Begin
- FP_AddPad(fp, inp, InFile);
- End;
- 'Line': Begin
- FP_AddLine(fp, inp);
- End;
- 'Arc': Begin
- FP_AddArc(fp, inp);
- End;
- 'Polygon': Begin
- FP_AddPoly(fp, inp, InFile);
- End;
- 'Text': Begin
- FP_AddText(fp, inp);
- End;
- 'Step': Begin
- FP_AddStep(fp, inp, InFileName);
- End;
- 'EndFootprint': Begin
- //ShowMessage('EndFootprint');
- Break;
- End;
- '': Continue;
- Else Begin
- ShowMessage('Keyword Error: ' + tag);
- Break;
- End;
- End;
- End; // while not eof()
- fp.EndModify();
- PCBServer.PostProcess();
- // done with footprint
- End;
- 'EndFootprints': Begin
- //ShowMessage('EndFootprint');
- Break;
- End;
- '': Continue;
- Else Begin
- ShowMessage('Keyword Error: ' + tag);
- Break;
- End;
- End; // case tag
- End; // while not eof()
- PCBServer.PostProcess();
-End;
-
-{==============================================================================}
-{==== Symbol Routines =======================================================}
-{==============================================================================}
-
-Function TextJustificationFromString(Value: String): TTextJustification;
-Begin
- Case Value Of
- 'BottomLeft': Result := eJustify_BottomLeft;
- 'BottomCenter': Result := eJustify_BottomCenter;
- 'BottomRight': Result := eJustify_BottomRight;
- 'CenterLeft': Result := eJustify_CenterLeft;
- 'Center': Result := eJustify_Center;
- 'CenterRight': Result := eJustify_CenterRight;
- 'TopLeft': Result := eJustify_TopLeft;
- 'TopCenter': Result := eJustify_TopCenter;
- 'TopRight': Result := eJustify_TopRight;
- Else Result := eJustify_Center;
- End;
-End;
-
-Function SY_GetFont(Height: Double, Angle: TRotationBy90): TFontID;
-Var
- sz : Integer;
-Begin
- // 2012-11-07 gbn start
- { sz := Round(Height / 10);
- According to this page's bugs 4604 and 5552, Altium 10.890.23450 may have this fixed.
- http://wiki.altium.com/pages/viewpage.action?pageId=34210039
- }
- sz := (Height * 0.1);
- // 2012-11-07 gbn end
-
- // 2019-01-16 gbn start, this should hopefully be temporary until Altium fixes their FontManager
- If BrokenSCHFontManager > 0 Then Begin
- Result := ForceSchFontID;
- Exit;
- End;
- // 2019-01-16 gbn
-
- Result := SchServer.FontManager.GetFontID(sz, Angle, False, False, False, False, 'Courier New');
-End;
-
-Function SY_GetAngle(Angle : String): TRotationBy90;
-Begin
- Case Angle Of
- '90': Result := eRotate90;
- '180': Result := eRotate180;
- '270': Result := eRotate270;
- Else Result := eRotate0;
- End;
-End;
-
-Procedure SY_AddLine(sy: ISch_Component, Data: String);
-Var
- lin : ISch_Line;
- s1, s2 ,s3: String;
-Begin
- lin := SchServer.SchObjectFactory(eLine, eCreate_Default);
- If lin = Nil Then Exit;
- StrChop(GetBetween(Data, '(Start ', ')'), ',', s1, s2);
- lin.Location := Point(MilsToCoord(Evaluate(s1)), MilsToCoord(Evaluate(s2)));
- StrChop(GetBetween(Data, '(End ', ')'), ',', s1, s2);
- lin.Corner := Point(MilsToCoord(Evaluate(s1)), MilsToCoord(Evaluate(s2)));
- GetBetween(Data, 'Width ', ')');
- If s3 < 10 Then Begin
- lin.LineWidth := eSmall;
- End;
- If s3 > 10 Then Begin
- lin.LineWidth := eMedium;
- End;
- If s3 > 12 Then Begin
- lin.LineWidth := eLarge;
- End;
- lin.LineStyle := eLineStyleSolid;
- lin.Color := $000000; // NOTE: TODO:
- lin.OwnerPartId := Evaluate(GetBetween(Data, '(Part ', ')'));
- lin.OwnerPartDisplayMode := sy.DisplayMode;
- sy.AddSchObject(lin);
- SchServer.RobotManager.SendMessage(sy.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, lin.I_ObjectAddress);
-End;
-
-Procedure SY_AddRect(sy: ISch_Component, Data: String);
-Var
- rect : ISch_Rectangle;
- s1, s2 ,s3: String;
-Begin
- rect := SchServer.SchObjectFactory(eRectangle, eCreate_Default);
- If rect = Nil Then Exit;
- StrChop(GetBetween(Data, '(Start ', ')'), ',', s1, s2);
- rect.Location := Point(MilsToCoord(Evaluate(s1)), MilsToCoord(Evaluate(s2)));
- StrChop(GetBetween(Data, '(End ', ')'), ',', s1, s2);
- rect.Corner := Point(MilsToCoord(Evaluate(s1)), MilsToCoord(Evaluate(s2)));
- GetBetween(Data, 'Width ', ')');
- s3 := GetBetween(Data, '(Width ', ')');
- If s3 < 10 Then Begin
- rect.LineWidth := eSmall;
- End;
- If s3 > 10 Then Begin
- rect.LineWidth := eMedium;
- End;
- If s3 > 12 Then Begin
- rect.LineWidth := eLarge;
- End;
- rect.Transparent := True;
- rect.Color := $000000; // NOTE: TODO:
- rect.OwnerPartId := Evaluate(GetBetween(Data, '(Part ', ')'));
- rect.OwnerPartDisplayMode := sy.DisplayMode;
- sy.AddSchObject(rect);
- SchServer.RobotManager.SendMessage(sy.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, rect.I_ObjectAddress);
-End;
-
-Procedure SY_AddArc(sy: ISch_Component, Data: String);
-Var
- arc : ISch_Arc;
- s1, s2, s3 : String;
-Begin
- arc := SchServer.SchObjectFactory(eArc, eCreate_Default);
- If arc = Nil Then Exit;
- StrChop(GetBetween(Data, '(Location ', ')'), ',', s1, s2);
- arc.Location := Point(MilsToCoord(Evaluate(s1)), MilsToCoord(Evaluate(s2)));
- arc.Radius := MilsToCoord(Evaluate(GetBetween(Data, '(Radius ', ')')));
- s3 := GetBetween(Data, '(Width ', ')');
- If s3 < 10 Then Begin
- arc.LineWidth := eSmall;
- End;
- If s3 > 10 Then Begin
- arc.LineWidth := eMedium;
- End;
- If s3 > 12 Then Begin
- arc.LineWidth := eLarge;
- End;
- arc.Color := $000000; // NOTE: TODO:
- arc.StartAngle := Evaluate(GetBetween(Data, '(StartAngle ', ')'));
- arc.EndAngle := Evaluate(GetBetween(Data, '(EndAngle ', ')'));
- arc.OwnerPartId := Evaluate(GetBetween(Data, '(Part ', ')'));
- arc.OwnerPartDisplayMode := sy.DisplayMode;
- sy.AddSchObject(arc);
- SchServer.RobotManager.SendMessage(sy.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, arc.I_ObjectAddress);
-End;
-
-Procedure SY_AddPoly(sy: ISch_Component, Data: String, InFile: TextFile);
-Var
- pol : ISch_Polygon;
- pc: Integer;
- s1, s2, inp, tag : String;
-Begin
- pol := SchServer.SchObjectFactory(ePolygon, eCreate_Default);
- If pol = Nil Then Exit;
-
- pol.VerticesCount := Evaluate(GetBetween(Data, '(PointCount ', ')'));
- pc := 0;
- While Not EOF(InFile) Do Begin
- ReadLn(InFile, inp);
- If VarIsNull(inp) Then Continue;
- inp := Trim(inp);
- StrChop(inp, ' ', tag, inp);
- tag := Trim(tag);
- Case tag Of
- 'Point': Begin
- pc := pc + 1;
- StrChop(GetBetween(inp, '(', ')'), ',', s1, s2);
- pol.Vertex[pc] := Point(MilsToCoord(Evaluate(s1)), MilsToCoord(Evaluate(s2)));
- End;
- 'EndPolygon': Break;
- Else Begin
- ShowMessage('Keyword Error: ' + tag);
- End;
- End;
- End;
- pol.LineWidth := eZeroSize; // NOTE: TODO:
- pol.Color := $000000; // NOTE: TODO:
- pol.IsSolid := True;
- pol.OwnerPartId := Evaluate(GetBetween(Data, '(Part ', ')'));
- pol.OwnerPartDisplayMode := sy.DisplayMode;
- sy.AddSchObject(pol);
- SchServer.RobotManager.SendMessage(sy.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, pol.I_ObjectAddress);
-End;
-
-Procedure SY_AddText(sy: ISch_Component, Data: String);
-Var
- txt : ISch_Label;
- s1, s2 : String;
-Begin
- txt := SchServer.SchObjectFactory(eLabel, eCreate_Default);
- If txt = Nil Then Exit;
- StrChop(GetBetween(Data, '(Location ', ')'), ',', s1, s2);
- txt.Location := Point(MilsToCoord(Evaluate(s1)), MilsToCoord(Evaluate(s2)));
- If GetBetween(Data, '(Mirrored ', ')') = 'True' Then Begin
- txt.IsMirrored := True;
- End;
- txt.Orientation := SY_GetAngle(GetBetween(Data, '(Rotation ', ')'));
- txt.FontID := SY_GetFont(Evaluate(GetBetween(Data, 'Height ', ')')), txt.Orientation);
- txt.Justification := TextJustificationFromString(GetBetween(Data, '(Justification ', ')'));
- txt.Color := $000000; // NOTE: TODO:
- txt.Text := GetBetween(Data, '(Value "', '")');
- txt.OwnerPartId := Evaluate(GetBetween(Data, '(Part ', ')'));
- txt.OwnerPartDisplayMode := sy.DisplayMode;
- sy.AddSchObject(txt);
- SchServer.RobotManager.SendMessage(sy.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, txt.I_ObjectAddress);
-End;
-
-Procedure SY_AddParam(sy: ISch_Component, Data: String);
-Var
- prm : ISch_Parameter;
- s1, s2: String;
-Begin
- prm := SchServer.SchObjectFactory(eParameter, eCreate_Default);
- If prm = Nil Then Exit;
- prm.IsHidden := True;
- If GetBetween(Data, '(Name ', '"') = 'Visible' Then Begin
- prm.IsHidden := False;
- End;
- prm.Name := GetBetween(Data, '(Name "', '")');
- StrChop(GetBetween(Data, '(Location ', ')'), ',', s1, s2);
- prm.Location := Point(MilsToCoord(Evaluate(s1)), MilsToCoord(Evaluate(s2)));
- If GetBetween(Data, '(Mirrored ', ')') = 'True' Then Begin
- prm.IsMirrored := True;
- End;
- prm.Orientation := SY_GetAngle(GetBetween(Data, '(Rotation ', ')'));
- prm.FontID := SY_GetFont(Evaluate(GetBetween(Data, 'Height ', ')')), prm.Orientation);
- prm.Justification := TextJustificationFromString(GetBetween(Data, '(Justification ', ')'));
- prm.Color := $000000; // NOTE: TODO:
- prm.Text := GetBetween(Data, '(Value "', '")');
- prm.OwnerPartId := Evaluate(GetBetween(Data, '(Part ', ')'));
- prm.OwnerPartDisplayMode := sy.DisplayMode;
- sy.AddSchObject(prm);
- SchServer.RobotManager.SendMessage(sy.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, prm.I_ObjectAddress);
-End;
-
-Procedure SY_AddComment(sy: ISch_Component, Data: String);
-Var
- prm : ISch_Parameter;
- s1, s2: String;
-Begin
- prm := SchServer.SchObjectFactory(eParameter, eCreate_Default);
- If prm = Nil Then Exit;
- prm.IsHidden := True;
- If GetBetween(Data, '(Name ', '"') = 'Visible' Then Begin
- prm.IsHidden := False;
- End;
- prm.Name := GetBetween(Data, '(Name "', '")');
- StrChop(GetBetween(Data, '(Location ', ')'), ',', s1, s2);
- prm.Location := Point(MilsToCoord(Evaluate(s1)), MilsToCoord(Evaluate(s2)));
- If GetBetween(Data, '(Mirrored ', ')') = 'True' Then Begin
- prm.IsMirrored := True;
- End;
- prm.Orientation := SY_GetAngle(GetBetween(Data, '(Rotation ', ')'));
- prm.FontID := SY_GetFont(Evaluate(GetBetween(Data, 'Height ', ')')), prm.Orientation);
- prm.Justification := TextJustificationFromString(GetBetween(Data, '(Justification ', ')'));
- prm.Color := $000000; // NOTE: TODO:
- prm.Text := GetBetween(Data, '(Value "', '")');
- prm.OwnerPartId := Evaluate(GetBetween(Data, '(Part ', ')'));
- prm.OwnerPartDisplayMode := sy.DisplayMode;
- sy.Comment := prm; // crashes, as of Altium 16.0.5
- SchServer.RobotManager.SendMessage(sy.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, prm.I_ObjectAddress);
-End;
-
-Procedure SY_AddPin(sy: ISch_Component, Data: String);
-Var
- pin : ISch_Pin;
- s1, s2 : String;
-Begin
- pin := SchServer.SchObjectFactory(ePin, eCreate_Default);
- If pin = Nil Then Exit;
-
- // Define the pin parameters.
- StrChop(GetBetween(Data, '(Location ', ')'), ',', s1, s2);
- pin.Location := Point(MilsToCoord(Evaluate(s1)), MilsToCoord(Evaluate(s2)));
- pin.Color := $000000; // NOTE: TODO:
- pin.Orientation := SY_GetAngle(GetBetween(Data, '(Rotation ', ')'));
- Case GetBetween(Data, '(PinType ', ')') Of
- 'IO': pin.Electrical := eElectricIO;
- 'Input': pin.Electrical := eElectricInput;
- 'Output': pin.Electrical := eElectricOutput;
- 'Passive': pin.Electrical := eElectricPassive;
- 'OpenCollector': pin.Electrical := eElectricOpenCollector;
- 'OpenEmitter': pin.Electrical := eElectricOpenEmitter;
- 'HiZ': pin.Electrical := eElectricHiZ;
- 'Power': pin.Electrical := eElectricPower;
- Else pin.Electrical := eElectricPassive;
- End;
- pin.PinLength := MilsToCoord(Evaluate(GetBetween(Data, '(Length ', ')')));
- pin.SwapId_Pin := GetBetween(Data, '(PinSwap ', ')');
- pin.SwapId_Part := GetBetween(Data, '(PartSwap ', ')');
- pin.SwapId_PartPin := GetBetween(Data, '(PinSeq ', ')');
- s1 := GetBetween(Data, '(Designator ', '")');
- pin.ShowDesignator := CheckLeft(s1, 'Visible');
- pin.Designator := RightOf(s1, '"');
- s1 := GetBetween(Data, '(Name ', '")');
- pin.ShowName := CheckLeft(s1, 'Visible');
- pin.Name := RightOf(s1, '"');
- pin.OwnerPartId := Evaluate(GetBetween(Data, '(Part ', ')'));
-
- pin.OwnerPartDisplayMode := sy.DisplayMode;
- sy.AddSchObject(pin);
- SchServer.RobotManager.SendMessage(sy.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, pin.I_ObjectAddress);
-End;
-
-Procedure ImportComponents(InFile: TextFile, Lib: ISch_Document, Errors: TStringList);
-Var
- inp, tag, s, t : String;
- sy : ISch_Component;
- simp : ISch_Implementation;
-Begin
- While Not EOF(InFile) Do Begin
- ReadLn(InFile, inp);
- If VarIsNull(inp) Then Continue;
-
- StrChop(inp, ' ', tag, inp);
- tag := Trim(tag);
- Case tag Of
- 'Component': Begin
- // create a component reference
- sy := SchServer.SchObjectFactory(eSchComponent, eCreate_Default);
- If sy = Nil Then Begin
- Errors.Add('Error creating component.');
- Break;
- End;
- // Set up parameters for the library component.
- SchServer.ProcessControl.PreProcess(Lib, '');
- // Define the LibReference and add the component to the library.
- sy.LibReference := GetBetween(inp, '(Name "', '")');
- sy.Designator.Text := GetBetween(inp, '(DesPrefix "', '")');
- sy.ComponentDescription := 'Imported';
- sy.PartCount := Evaluate(GetBetween(inp, '(PartCount ', ')'));
- sy.CurrentPartId := 1;
-
- // add data to it
- While Not EOF(InFile) Do Begin
- ReadLn(InFile, inp);
- If VarIsNull(inp) Then Continue;
- StrChop(inp, ' ', tag, inp);
- Case tag Of
- 'Description': Begin
- //sy.SourceDescription := GetBetween(inp, '(Value "', '")'); ' SourceDescription doesnt exist (as of 16.0.5)
- sy.ComponentDescription := GetBetween(inp, '(Value "', '")');
- End;
- 'Comment': Begin
- //sy.Comment.UnderlyingString := GetBetween(inp, '(Value "', '")'); ' Comment.UnderlyingString doesnt exist (as of 16.0.5)
- //sy.Comment.DisplayString := GetBetween(inp, '(Value "', '")'); // crashes
- //SY_AddComment(sy, inp); // crashes (see function)
- sy.Comment.text :=getbetween(inp, '(Value "', '")');
- End;
- 'Parameter': Begin
- SY_AddParam(sy, inp);
- End;
- 'Pin': Begin
- SY_AddPin(sy, inp);
- End;
- 'Line': Begin
- SY_AddLine(sy, inp);
- End;
- 'Rectangle': Begin
- SY_AddRect(sy, inp);
- End;
- 'Arc': Begin
- SY_AddArc(sy, inp);
- End;
- 'Polygon': Begin
- SY_AddPoly(sy, inp, InFile);
- End;
- 'Text': Begin
- SY_AddText(sy, inp);
- End;
- 'Footprint': Begin
- simp := sy.AddSchImplementation();
- simp.ModelName := GetBetween(inp, '(Name "', '")');
- simp.ModelType := cDocKind_PcbLib;
- simp.AddDataFileLink(simp.ModelName, '', cDocKind_PcbLib);
- simp.MapAsString := GetBetween(inp, '(Map "', '")');
- End;
- 'EndComponent': Begin
- Lib.AddSchComponent(sy);
- // Send a system notification that a new component has been added to the library.
- SchServer.RobotManager.SendMessage(Lib.I_ObjectAddress, c_BroadCast, SCHM_PrimitiveRegistration, sy.I_ObjectAddress);
- Lib.CurrentSchComponent := sy;
- Break;
- End;
- '': Continue;
- Else Begin
- ShowMessage('Keyword Error: ' + tag);
- Break;
- End;
- End;
- End; // while not eof()
- // done with component
- SchServer.ProcessControl.PostProcess(Lib, '');
- End;
- 'EndComponents': Begin
- Break;
- End;
- '': Continue;
- Else Begin
- ShowMessage('Keyword Error: ' + tag);
- Break;
- End;
- End; // case tag
- End; // while not eof()
-End;
-
-{==============================================================================}
-{==== Main Routines =========================================================}
-{==============================================================================}
-
-Function InitLibDocs(BasePath: String,
- Out Proj : IProject,
- Out ProjDoc : IServerDocument,
- Out PcbLibDoc : IServerDocument,
- Out SchLibDoc : IServerDocument,
- Out pLib : IPCB_Library,
- Out sLib : ISch_Document): Boolean;
-Var
- WorkSpace : IWorkSpace;
-Begin
- Result := False;
- WorkSpace := GetWorkSpace;
- If WorkSpace = Nil Then Begin
- ShowMessage('Nil WorkSpace');
- Exit;
- End;
- // Integrated library, and the project it creates
- ProjDoc := Client.OpenNewDocument(cDocKind_IntegratedLibrary, 'UL_Imported_Lib', 'UL_Imported_Lib', False);
- If ProjDoc = Nil Then Begin
- ShowMessage('Nil ProjDoc');
- Exit;
- End;
- If Not ProjDoc.DoSafeChangeFileNameAndSave(BasePath + '.LibPkg', cDocKind_IntegratedLibrary) Then Begin
- ShowMessage('ProjDoc Save failed');
- Exit;
- End;
- Proj := WorkSpace.DM_GetProjectFromPath(BasePath + '.LibPkg');
- If Proj = Nil Then Begin
- ShowMessage('Nil Proj');
- Exit;
- End;
- // Footprint library
- PcbLibDoc := Client.OpenNewDocument(cDocKind_PcbLib, 'UL_Footprints', 'UL_Footprints', False);
- If PcbLibDoc = Nil Then Begin
- ShowMessage('Nil PcbLibDoc');
- Exit;
- End;
- If Not PcbLibDoc.DoSafeChangeFileNameAndSave(BasePath + '.PcbLib', cDocKind_PcbLib) Then Begin
- ShowMessage('PcbLibDoc Save failed');
- Exit;
- End;
- Proj.DM_AddSourceDocument(BasePath + '.PcbLib');
- pLib := PCBServer.GetPCBLibraryByPath(BasePath + '.PcbLib');
- If pLib = Nil Then Begin
- ShowMessage('Nil pLib');
- Exit;
- End;
- // Symbol Library
- SchLibDoc := Client.OpenNewDocument(cDocKind_SchLib, 'UL_Components', 'UL_Components', False);
- If SchLibDoc = Nil Then Begin
- ShowMessage('Nil SchLibDoc');
- Exit;
- End;
- If Not SchLibDoc.DoSafeChangeFileNameAndSave(BasePath + '.SchLib', cDocKind_SchLib) Then Begin
- ShowMessage('SchLibDoc Save failed');
- Exit;
- End;
- Proj.DM_AddSourceDocument(BasePath + '.SchLib');
- sLib := SchServer.GetSchDocumentByPath(BasePath + '.SchLib');
- If sLib = Nil Then Begin
- ShowMessage('Nil sLib');
- Exit;
- End;
- // Done
- Result := True;
-End;
-
-Procedure ImportAscIIData(InFileName : String);
-Var
- WorkSpace : IWorkSpace;
- dProj : IProject;
-
- Proj : IProject;
- ProjDoc : IServerDocument;
- PcbLibDoc : IServerDocument;
- SchLibDoc : IServerDocument;
- pLib : IPCB_Library;
- sLib : ISch_Document;
-
- DefFP : IPCB_Component; // default initial blank footprint
- DefSY : ISch_Component; // default initial blank symbol
-
- SavePath: String;
-
- InFile : TextFile;
- Errors : TStringList;
- inp, tag : String;
-Begin
-
- // 2019-01-16 gbn start, try to detect Altium 19, so we can kludge around its broken SCH FontMangaer
- If '19.0' < GetCurrentProductBuild Then Begin
- ShowMessage('NOTE: This version of Altium has issues with the Schematic FontManger''s scripting interface.' +
- ' All symbol texts and parameters will use the FontID specified by the ForceSchFontID integer at the top of UL_Import.pas.');
- BrokenSCHFontManager := 1;
- End;
- // 2019-01-16 gbn end
-
- //SavePath := LeftOf(InFileName, '.'); // 2019-10-02 gbn
- SavePath := LeftOfLast(InFileName, '.');
- Errors := TStringList.Create();
-
- WorkSpace := GetWorkSpace;
- If WorkSpace = Nil Then Begin
- ShowMessage('Nil WorkSpace');
- Exit;
- End;
- dProj := WorkSpace.DM_FocusedProject();
-
- // create integerated library documents
- If InitLibDocs(SavePath, Proj, ProjDoc, PcbLibDoc, SchLibDoc, pLib, sLib) = False Then Begin
- ShowMessage('Error initializing library');
- Exit;
- End;
- Proj.DM_SetAsCurrentProject();
-
- // get the original blank footprint for later deletion when we are done
- DefFP := pLib.CurrentComponent;
- // get the original blank symbol for later deletion when we are done
- DefSy := sLib.CurrentSchComponent;
-
- // start importing data
- AssignFile(InFile, InFileName);
- Reset(InFile);
-
- While Not EOF(InFile) Do Begin
- ReadLn(InFile, inp);
- If VarIsNull(inp) Then Continue;
-
- StrChop(inp, ' ', tag, inp);
- tag := Trim(tag);
- Case tag Of
- 'StartFootprints': Begin
- ImportFootprints(InFile, pLib, Errors, InFileName);
- End;
- 'StartComponents': Begin
- ImportComponents(InFile, sLib, Errors);
- End;
- '': Continue;
- End;
- End;
- CloseFile(InFile);
-
- // delete the original default blank footprint
- If Not VarIsNull(DefFP) Then Begin
- pLib.DeRegisterComponent(DefFP);
- pLib.RemoveComponent(DefFP);
- End Else Begin
- ShowMessage('DefFP was Nil');
- End;
- // delete the original default blank symbol
- // NOTE: TODO: looks broken; does nothing noticable
- If Not VarIsNull(DefSY) Then Begin
- //ShowMessage('trying to delete DefSym "' + DefSy.LibReference + '"');
- sLib.UnRegisterSchObjectFromContainer(DefSY);
- sLib.RemoveSchObject(DefSy);
- //DefSY.Container.RemoveSchObject(DefSy);
- End Else Begin
- ShowMessage('DefSym was Nil');
- End;
-
- // update views?
- pLib.Board.ViewManager_FullUpdate();
- // Refresh symbol library.
- sLib.GraphicallyInvalidate();
-
- // save files again
- ProjDoc.DoFileSave(cDocKind_IntegratedLibrary);
- PcbLibDoc.DoFileSave(cDocKind_PcbLib);
- SchLibDoc.DoFileSave(cDocKind_SchLib);
-
- //2021-01-19 JRR Start; commenting out the below section since the autoit routine does not catch the message box frrom the script
- //// set the original project back to its focus
- //If dProj <> Nil Then Begin
- // dProj.DM_SetAsCurrentProject();
- //End;
-
- //ShowMessage('Done with "' + SavePath + '"');
- //2021-01-19 JRR End
-End;
-
generated by cgit v1.2.3 (git 2.46.0) at 2024-11-25 23:04:44 +0000