Sub Main Begin Dialog UserDialog 440,98,"Generating Stackup for 2D lines Library",.CallbackFunc ' %GRID:10,7,1,1 Text 10,7,420,14,"2D lines Library",.Text1 TextBox 10,21,420,21,.Edt2DLName PushButton 220,49,100,21,"Execute",.BtnExecute PushButton 330,49,100,21,"Close",.BtnClose Text 10,77,420,14,"",.Status End Dialog Dim dlg As UserDialog Dialog dlg End Sub Rem See DialogFunc help topic for more information. Private Function CallbackFunc(DlgItem$, Action%, SuppValue%) As Boolean Select Case Action% Case 1 DlgText "Edt2DLName",ActiveDocument.path & "\" & ActiveDocument.ElectricalLayerCount & "-Stackup.l" ' Dialog box initialization Case 2 ' Value changing or button pressed CallbackFunc = True ' Prevent button press from closing the dialog box If DlgItem$ = "BtnClose" Then CallbackFunc = False If DlgItem$ = "BtnExecute" Then StackupName= Mid(DlgText("Edt2DLName"), InStrRev(DlgText("Edt2DLName"), "\") + 1, InStrRev(DlgText("Edt2DLName"), ".") - InStrRev(DlgText("Edt2DLName"), "\") - 1) Open DlgText("Edt2DLName") For Output As #1 '''header''' lineNum=0 TextNum=0 layTl=ActiveDocument.ElectricalLayerCount For n=1 To layTl If ActiveDocument.Layers(n).Type=1 Then lineNum=lineNum+4 TextNum=TextNum+2 ElseIf ActiveDocument.Layers(n).PlaneType<>0 Then lineNum=lineNum+2 TextNum=TextNum+1 Else lineNum=lineNum+3 TextNum=TextNum+1 End If Next n Print #1, UCase("*PADS-Library-Line-ITEMS-V9*") & vbCrLf Print #1, UCase(StackupName & " LINES I ") & "-1000 -1000 " & lineNum + (layTl-1)*2 & Space(1) & TextNum + layTl-1 Print #1, UCase("TIMESTAMP " & Format(Date(),"yyyy.mm.dd") & "." & Format(Time(),"hh.mm.ss")) '''Line''''''''''''''''' For n=1 To layTl Select Case n Case 1 'Trace Print #1, UCase("Open 3 10 24 -1") & vbCrLf & "1100 50" & vbCrLf & "1165 115" & vbCrLf & "1600 115" Print #1, UCase("Open 2 10 24 -1") & vbCrLf & "1250 0" & vbCrLf & "1600 0" Print #1, UCase("Open 2 10 24 -1") & vbCrLf & "1435 -115" & vbCrLf & "1600 -115" Print #1, UCase("Open 2 50 24 -1") & vbCrLf & "200 0" & vbCrLf & "400 0" Print #1, UCase("Open 2 50 24 -1") & vbCrLf & "1000 0" & vbCrLf & "1200 0" Print #1, UCase("CLOSED 5 15 24 -1") & vbCrLf & "0 -75" & vbCrLf & "1400 -75" & vbCrLf & "1400 -155" & vbCrLf & "0 -155" & vbCrLf & "0 -75" Case layTl Print #1, UCase("Open 3 10 24 -1") & vbCrLf & "1100 " & (layTl*2-2)*-115-50 & vbCrLf & "1165 " & (layTl*2-2)*-115-115 & vbCrLf & "1600 " & (layTl*2-2)*-115-115 Print #1, UCase("Open 2 10 24 -1") & vbCrLf & "1250 " & (layTl*2-2)*-115 & vbCrLf & "1600 " & (layTl*2-2)*-115 Print #1, UCase("Open 2 50 24 -1") & vbCrLf & "200 " & (layTl*2-2)*-115 & vbCrLf & "400 " & (layTl*2-2)*-115 Print #1, UCase("Open 2 50 24 -1") & vbCrLf & "1000 " & (layTl*2-2)*-115 & vbCrLf & "1200 " & (layTl*2-2)*-115 Case Else If ActiveDocument.Layers(n).PlaneType<>0 Then Print #1, UCase("Open 2 10 24 -1") & vbCrLf & "1400 " & (n*2-2)*-115 & vbCrLf & "1600 " & (n*2-2)*-115 Print #1, UCase("Open 2 10 24 -1") & vbCrLf & "1435 " & (n*2-2)*-115-115 & vbCrLf & "1600 " & (n*2-2)*-115-115 Print #1, UCase("Open 2 50 24 -1") & vbCrLf & "50 " & (n*2-2)*-115 & vbCrLf & "1350 " & (n*2-2)*-115 Print #1, UCase("CLOSED 5 15 24 -1") & vbCrLf & "0 " & (n*2-2)*-115-75 & vbCrLf & "1400 " & (n*2-2)*-115-75 & vbCrLf & "1400 " & (n*2-2)*-115-155 & vbCrLf & "0 " & (n*2-2)*-115-155 & vbCrLf & "0 " & (n*2-2)*-115-75 Else Print #1, UCase("Open 2 10 24 -1") & vbCrLf & "1250 " & (n*2-2)*-115 & vbCrLf & "1600 " & (n*2-2)*-115 Print #1, UCase("Open 2 10 24 -1") & vbCrLf & "1435 " & (n*2-2)*-115-115 & vbCrLf & "1600 " & (n*2-2)*-115-115 Print #1, UCase("Open 2 50 24 -1" & vbCrLf & "200 " & (n*2-2)*-115 & vbCrLf & "400 " & (n*2-2)*-115) Print #1, UCase("Open 2 50 24 -1" & vbCrLf & "1000 " & (n*2-2)*-115 & vbCrLf & "1200 " & (n*2-2)*-115) Print #1, UCase("CLOSED 5 15 24 -1") & vbCrLf & "0 " & (n*2-2)*-115-75 & vbCrLf & "1400 " & (n*2-2)*-115-75 & vbCrLf & "1400 " & (n*2-2)*-115-155 & vbCrLf & "0 " & (n*2-2)*-115-155 & vbCrLf & "0 " & (n*2-2)*-115-75 End If End Select Next n '''Text'''''''''''''''''''' For n=1 To layTl '''''UnitName''''' If (ActiveDocument.unit=ppcbUnitMetric) Then UnitName = "mm" If (ActiveDocument.unit=ppcbUnitMils) Then UnitName = "mils" If (ActiveDocument.unit=ppcbUnitInch) Then UnitName = "inch" LayerNm=ActiveDocument.Layers(n).Name If (ActiveDocument.Layers(n).Type=1) Then LayerTp = "Component" If (ActiveDocument.Layers(n).Type=2) Then LayerTp = "Routing" If (ActiveDocument.Layers(n).PlaneType<>0) Then LayerTp = "Plane" If (ActiveDocument.Layers(n).GetDielectricType(0)=0) Then LayerDTp = "SolderMask" 'Coating If (ActiveDocument.Layers(n).GetDielectricType(0)=1) Then LayerDTp = "Substrate" If (ActiveDocument.Layers(n).GetDielectricType(0)=2) Then LayerDTp = "Prepreg" If (ActiveDocument.unit=ppcbUnitMetric) Then LayerCT=Format(ActiveDocument.Layers(n).CopperThickness(0)/0.03429,"0.000") If (ActiveDocument.unit=ppcbUnitMils) Then LayerCT=Format(ActiveDocument.Layers(n).CopperThickness(0)/1.35,"0.000") If (ActiveDocument.unit=ppcbUnitInch) Then LayerCT=Format(ActiveDocument.Layers(n).CopperThickness(0)/0.00135,"0.000") 'LayerCT=Format(ActiveDocument.Layers(n).CopperThickness(0)/1.35,"0.000") LayerDTn=Format(ActiveDocument.Layers(n).GetDielectricThickness(0,0),"0.000") LayerDCo=Format(ActiveDocument.Layers(n).GetDielectricConstant(0),"0.00") Select Case n Case 1 Print #1, "1650 85 0 24 100 10 0 0 0 0 ""Regular "" Print #1, LayerDTp & ",THICKNESS=" & LayerDTn & UnitName & ",Er=" & LayerDCo Print #1, "1650 -30 0 24 100 10 0 0 0 0 ""Regular "" Print #1, LayerNm & "," & LayerTp & ",THICKNESS=" & LayerCT & "oz" Case layTl Print #1, "1650 " & (layTl*2-2)*-115+85 & " 0 24 100 10 0 0 0 0 ""Regular "" Print #1, LayerDTp & ",THICKNESS=" & LayerDTn & UnitName &",Er=" & LayerDCo If (ActiveDocument.Layers(n).GetDielectricType(1)=0) Then LayerDTp = "SolderMask" 'Coating If (ActiveDocument.Layers(n).GetDielectricType(1)=1) Then LayerDTp = "Substrate" If (ActiveDocument.Layers(n).GetDielectricType(1)=2) Then LayerDTp = "Prepreg" LayerDTn=Format(ActiveDocument.Layers(n).GetDielectricThickness(1,0),"0.000") LayerDCo=Format(ActiveDocument.Layers(n).GetDielectricConstant(1),"0.00") Print #1, "1650 " & (layTl*2-2)*-115-145 & " 0 24 100 10 0 0 0 0 ""Regular "" Print #1, LayerDTp & ",THICKNESS=" & LayerDTn & UnitName & ",Er=" & LayerDCo Print #1, "1650 " & (layTl*2-2)*-115-30 & " 0 24 100 10 0 0 0 0 ""Regular "" Print #1, LayerNm & "," & LayerTp & ",THICKNESS=" & LayerCT & "oz" Case Else Print #1, "1650 " & (n*2-2)*-115+85 & " 0 24 100 10 0 0 0 0 ""Regular "" Print #1, LayerDTp & ",THICKNESS=" & LayerDTn & UnitName & ",Er=" & LayerDCo Print #1, "1650 " & (n*2-2)*-115-30 & " 0 24 100 10 0 0 0 0 ""Regular "" Print #1, LayerNm & "," & LayerTp & ",THICKNESS=" & LayerCT & "oz" End Select Next n Print #1, vbCrLf & UCase("*End*") Close #1 ''''''''''''''''''''''''''''''''''''''''''' DlgText "Status", "The Stackup 2D Lines library generated successfully!" End If Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle Rem CallbackFunc = True ' Continue getting idle actions Case 6 ' Function key End Select End Function