diff options
Diffstat (limited to 'EE3102/Libraries/InstrumentAmp/UL_Import.pas')
| -rw-r--r-- | EE3102/Libraries/InstrumentAmp/UL_Import.pas | 1081 |
1 files changed, 1081 insertions, 0 deletions
diff --git a/EE3102/Libraries/InstrumentAmp/UL_Import.pas b/EE3102/Libraries/InstrumentAmp/UL_Import.pas new file mode 100644 index 0000000..fd9b912 --- /dev/null +++ b/EE3102/Libraries/InstrumentAmp/UL_Import.pas @@ -0,0 +1,1081 @@ + +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; + |