From f3f8cbd69e290ccbd60f9cbc0b1d9b63645127bb Mon Sep 17 00:00:00 2001 From: Matt Strapp Date: Sun, 28 Mar 2021 10:12:10 -0500 Subject: Add a basic VtoI function Also rearrange things and commit iconoclasm --- EE3102/Libraries/InstrumentAmp/UL_Import.pas | 1081 -------------------------- 1 file changed, 1081 deletions(-) delete mode 100644 EE3102/Libraries/InstrumentAmp/UL_Import.pas (limited to 'EE3102/Libraries/InstrumentAmp/UL_Import.pas') 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; - -- cgit v1.2.3