关于scripts问题的请教。

android2002 · 发表于 2013-1-5 13:07

EDA365欢迎您登录！

您需要登录才可以下载或查看，没有帐号？注册

x

期间坐标输出的格式为
Position X Position Y
1498.48 102.62
254.25 697.56
1750 510
1329.72 505.92
对应的语句为：
OutCell Format(part.PositionX, "0.00")
OutCell Format(part.PositionY, "0.00")

如果我想输出格式变为
Position
1498.48，102.62
254.25，697.56
1750，510
1329.72，505.92

Sub OutCell (txt As String)
Print #1, txt; vbTab;
End Sub

tmlee · 发表于 2013-1-5 16:46

OutCell Format(part.PositionX, "0.00");",";
OutCell Format(part.PositionY, "0.00")

tmlee · 发表于 2013-1-5 16:47

本帖最后由 tmlee 于 2013-1-5 16:59 编辑

OutCell Format(part.PositionX, "0.00");",";
OutCell Format(part.PositionY, "0.00")

Dim CurCol As Integer 'Current column index staring from 0

Sub OutCell (txt As String)
w = Widths(CurCol)
txt = Left(txt, w)
Print #1, txt; Space(w - Len(txt) + 1);
CurCol = CurCol + 1
End Sub

android2002 · 发表于 2013-1-6 08:49

很感谢，但貌似不对。

tmlee · 发表于 2013-1-6 08:57

android2002 发表于 2013-1-6 08:49
; j2 ^ w! ~: d% S很感谢，但貌似不对。

你只抽中間二句很难理解的

这是我以前做的,你可以看看

'This script has been generated by PowerPCB's VB Script Wizard on 2010/1/3 20:47:34
'It will create reports in Text format.
'For better look, turn off 'Word Wrap' item in the Edit menu of Notepad and use Courier or any other fixed width font.
'You can use the following code as a skeleton for your own VB scripts

'Arrays of column name and widths. You can modify them to rename, shrink, or expand columns
Const Columns = Array("Name", "Part Type", "PCB Decal", "SMD", "Value", "Position X", "Position Y", "Orientation", "Layer Name", "Layer Number")
Const Widths  = Array(    8,       10,       10,    3,    8,          10,          10,          10,          30,          12)

Sub Main
'Make report file name from current schematic file name
fname = ActiveDocument
If fname = "" Then
fname = "Untitled"
report = DefaultFilePath & "\default.scr"
Else
nm = Left(fname, Len( fname) - 4)
report = DefaultFilePath & "\" & nm & ".scr"
End If
Open report For Output As #1
'Output report header
Print #1, "# Scr file gen Ver 1.0 for EaglePCB by T.M.Lee  File:= "; fname; " on "; Now

If UnitName(ActiveDocument.unit)<>"mils" Then
' Print #1,"GRID MIL;"
Beep
MsgBox "Convert only support 'mils' Please change at Tool/Options/Design units/to 'mils'"

GoTo pro_end:

End If
' If UnitName(ActiveDocument.unit)="mm" Then
' Print #1,"GRID MM;"
' End If
' If UnitName(ActiveDocument.unit)="inches" Then
' Print #1,"GRID INCH;"
' End If

Print #1,"GRID OFF;"
Print #1,"GRID MIL 1;"
Print #1,"Set WIRE_BEND 3"
Print #1,"Set OPTIMIZING On"

' Print #1,"# Board designed Unit= ";UnitName(ActiveDocument.unit)
Print #1,"#************************ Add part  ***************************************"

For Each opt In ActiveDocument.AssemblyOptions

'Output table header
L = UBound(Columns)
CurCol = 0
For i = 0 To UBound(Columns)
' OutCell Columns(i)
L = L + Widths(i)
Next
' Print #1
' Print #1, String(L, "-")
'Output table rows
For Each part In opt.Components
CurCol = 0
Print #1,"ADD ";
Print #1,Left(part.Decal,Len(part.Decal));"@userAA.lbr ";

         If UCase$(Left$(part.Name,1))="R" Then
Print #1,"S";
End If
         Print #1, UCase$(part.Name);
      Print #1," R";Left(part.Orientation,Len(part.Orientation));

' use part center instead of part location for free orgin ( no need to change  pads part orgin )
'       Print #1," ("; Format(part.PositionX, "0.000" );
'       Print #1," ";Format(part.PositionY, "0.000" );");";

      Print #1," ("; Format(part.CenterX, "0.000" );
      Print #1," ";Format(part.CenterY, "0.000" );");";


Print #1
Next part

Print #1,"#************************ Add VIA ***************************************"

Print #1,"CHANGE layer TOP;"

For Each aVia In ActiveDocument.Vias
CurCol = 0

   Print #1,"VIA 56 round 1-16 ";
         Print #1," ("; Format(aVia.PositionX, "0.000" );
      Print #1," ";Format(aVia.PositionY, "0.000" );");";

' OutCell Format(aVia.PositionX, "0.000")
' OutCell Format(aVia.PositionY, "0.000")
Print #1
Next aVia

Print #1,"#************************ Add route *************************************"

'Print #1,"CHANGE layer TOP;"
'Print #1,"WIRE '#$$$1' 12.0000 (750.000  1450.000) (825.000  1525.000);"

Next opt

layer=1
layer_use=" "
Print #1,"CHANGE layer TOP;"
For Each seg In ActiveDocument.RouteSegments
CurCol = 0
If Val(seg.layer)<> layer Then
layer=Val(seg.layer)
layer_use=Str$(layer)
If layer="1" Then
layer_use=" TOP"
End If
If layer="2" Then
layer_use=" BOTTOM"
End If

Print #1,"CHANGE layer";layer_use;";"
End If

Print #1,"WIRE '#";
Print #1, seg.Net;"'";" ";
' Print #1, Format(seg.Length, "0.000" );" ";
Print #1, Format(seg.width, "0.0000" );" ";
' Print #1, IIf(seg.SegmentType = ppcbSegmentLine, "Line", IIf(seg.SegmentType = ppcbSegmentArc, "Arc",""));" ";
' Print #1, ActiveDocument.LayerName(seg.layer);" ";
' Print #1, seg.layer;" ";
Print #1,"(";
Print #1, GetPoint(seg, 1, 1);" ";
Print #1, GetPoint(seg, 1, 2);
Print #1,") ";

Print #1,"(";
Print #1, GetPoint(seg, 2, 1);" ";
      Print #1, GetPoint(seg, 2, 2);
      Print #1,"); "


'         Print #1,"(";
' Print #1, GetPoint(seg, 3, 1);" ";
' Print #1, GetPoint(seg, 3, 2);
' Print #1,") ";

' Print #1
Next seg

Print #1,"GRID DEFAULT;"

StatusBarText = ""
Close #1
'Do not forget quotes for file name!
Shell "Notepad " & Chr(34) & report & Chr(34), 1

pro_end:
End Sub
Function GetPoint (seg As Object, i As Integer, j As Integer)
GetPoint = ""
If (UBound(seg.Points, 1) >= i) And (UBound(seg.Points, 2) >= j) Then GetPoint = Format(seg.Points(i, j), "0.000")
End Function

Function GetOptName(opt As Object)
GetOptName = Left(opt.Name, Len(opt.Name) - (Len(ActiveDocument.Name) + 1))
End Function

Function AttrVal (obj As Object, nm As String)
AttrVal = IIf(obj.Attributes(nm) Is Nothing, "", obj.Attributes(nm))
End Function

Dim CurCol As Integer 'Current column index staring from 0

Sub OutCell (txt As String)
w = Widths(CurCol)
txt = Left(txt, w)
Print #1, txt; Space(w - Len(txt) + 1);
CurCol = CurCol + 1
End Sub
Function UnitName(unit As Long) As String

Select Case unit

Case ppcbUnitMils

UnitName = "mils"

Case ppcbUnitInch

UnitName = "inches"

Case ppcbUnitMetric

UnitName = "mm"

Case Else

UnitName = "unknown"

End Select

End Function

android2002 · 发表于 2013-1-7 13:12

Const Columns = Array("Reference Name", " Part Name", "Place Side", "Abs.Ang","Coordinates X","Coordinates Y", "Value","Value2")
Dim fname As String

Sub Main
fname = ActiveDocument
If fname = "" Then
fname = "Partlist"
End If
tempFile = DefaultFilePath & "\temp.txt"
Open tempFile For Output As #1

StatusBarText = "Generating report..."
'Output table header
For i = 0 to UBound(Columns)
OutCell Columns(i)
Next
Print #1
'Output table rows
For Each part in ActiveDocument.Components
OutCell part.Name
OutCell part.PartType
OutCell ActiveDocument.LayerName(part.layer)
OutCell part.Orientation
'Outdoor Format(part.CenterX, "0.00" )
'Outdoor Format(part.CenterY, "0.00" )
Print #1, Format(part.CenterX, "0.00" );
      Print #1,",";Format(part.CenterY, "0.00" );
OutCell Format(part.PositionX, "0.00")
'OutCell Format(part.PositionX, "0.00")
'OutCell Format(part.PositionY, "0.00")
OutCell AttrVal(part, "Value")
OutCell AttrVal(part, "Value2")
Print #1
Next part

StatusBarText = ""
Close #1
ExportToExcel
End Sub

Function AttrVal (obj As Object, nm As String)
AttrVal = IIf(obj.Attributes(nm) Is Nothing, "", obj.Attributes(nm))
End Function

Sub ExportToExcel
FillClipboard
Dim xl As Object
On Error Resume Next
Set xl =  GetObject(,"Excel.Application")
On Error GoTo ExcelError ' Enable error trapping.
If xl Is Nothing Then
Set xl =  CreateObject("Excel.Application")
End If
xl.Visible = True
xl.Workbooks.Add
xl.ActiveSheet.Paste
xl.Range("A1:H1").Font.Bold = True
xl.Range("A1:H1").NumberFormat = "@"
xl.Range("A1:H1").AutoFilter
xl.ActiveSheet.UsedRange.Columns.AutoFit
'Output Report Header

xl.Rows(1).Insert
xl.Rows(1).Cells(1) ="#######################################################################################################################"
xl.Rows(2).Insert
xl.Rows(2).Cells(1) = Space(1) & "Partlist-Report for " & fname
xl.Rows(3).Insert
xl.Rows(3).Cells(1) ="#######################################################################################################################"

'xl.Rows(1).Font.bold = True
xl.Range("A1").Select
On Error GoTo 0 ' Disable error trapping.
Exit Sub

ExcelError:
MsgBox Err.Description, vbExclamation, "Error Running Excel"
On Error GoTo 0 ' Disable error trapping.
Exit Sub
End Sub

Dim CurCol As Integer       'Current column index staring from 0

Sub OutCell (txt As String)
If txt="Top" Then
txt="A_SIDE"
End If
If txt="Bottom" Then
txt="B_SIDE"
End If
      Print #1, txt; vbTab;
End Sub

'Dim CurColl As Integer       'Current column index staring from 0
'Sub Outdoor (txtl As String)
'       wth= Columns(CurColl)
'       txtl = Left(txtl, wth)
'    Print #1, txtl; Space(wth - Len(txtl) + 1);
'       CurColl = CurColl + 1
'End Sub

Sub FillClipboard
StatusBarText = "Export Data To Clipboard..."
' Load whole file to string variable
tempFile = DefaultFilePath & "\temp.txt"
Open tempFile  For Input As #1
L = LOF(1)
AllData$ = Input$(L,1)
Close #1
'Copy whole data to clipboard
Clipboard AllData$
Kill tempFile
StatusBarText = ""
End Sub

非常感谢你的帮忙，按照你的格式我能弄出要求的形式，但是需要以函数的形式输出。给你看看我的吧，不能直接printf。麻烦你帮忙弄个调用函数的格式，谢谢～

tmlee · 发表于 2013-1-7 20:57

不能直接printf。

弄个调用函数的格式

不明白怎样是调用函数的格式?

android2002 · 发表于 2013-1-8 12:02

Sub Main
      fname = ActiveDocument
      If fname = "" Then
            fname = "Partlist"
      End If
      tempFile = DefaultFilePath & "\temp.txt"
      Open tempFile For Output As #1

      StatusBarText = "Generating report..."
      'Output table header
      For i = 0 to UBound(Columns)
            OutCell Columns(i)
      Next
      Print #1
      'Output table rows
      For Each part in ActiveDocument.Components
            OutCell part.Name
            OutCell part.PartType
            OutCell ActiveDocument.LayerName(part.layer)
            OutCell part.Orientation
            'Outdoor Format(part.CenterX, "0.00" )
            'Outdoor Format(part.CenterY, "0.00" )
            Print #1, Format(part.CenterX, "0.00" );
      Print #1,",";Format(part.CenterY, "0.00" );
            OutCell Format(part.PositionX, "0.00")
            'OutCell Format(part.PositionX, "0.00")
            'OutCell Format(part.PositionY, "0.00")
            OutCell AttrVal(part, "Value")
            OutCell AttrVal(part, "Value2")
            Print #1
      Next part

      StatusBarText = ""
      Close #1
      ExportToExcel
End Sub

请看这里是采用调用OutCell 子程序生成的信息。

Sub OutCell (txt As String)
Print #1, txt; vbTab;
End Sub

renyox · 发表于 2019-8-8 09:33

学习学习

帐号		自动登录	找回密码
密码			注册

关于scripts问题的请教。

EDA365欢迎您登录！

浏览过的版块

推荐内容 /1