| Line No. | Rev | Author | Line |
|---|---|---|---|
| 1 | 3 | kaklik | ' struktura pro funce vyberu adresare |
| 2 | Type BROWSEINFO |
||
| 3 | hwndOwner As Long |
||
| 4 | pidlRoot As Long |
||
| 5 | pszDisplayName As Long |
||
| 6 | lpszTitle As Long |
||
| 7 | ulFlags As Long |
||
| 8 | lpfn As Long |
||
| 9 | lParam As Long |
||
| 10 | iImage As Long |
||
| 11 | End Type |
||
| 12 | |||
| 13 | |||
| 14 | ' dekalrace fci z Windows pro vyhledani adresare |
||
| 15 | Private Declare Function SHBrowseForFolder Lib "shell32.dll" (ByRef bi As BROWSEINFO) As Long |
||
| 16 | Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal dirName As String) As Long |
||
| 17 | Sub Main |
||
| 18 | |||
| 19 | PathName$=ActiveDocument.path ' defaultni cesta, tam co je design |
||
| 20 | 'vytvoreni dialogu |
||
| 21 | Begin Dialog UserDialog 510,315,"Automat",.CallbackFunc ' %GRID:10,7,1,1 |
||
| 22 | OKButton 40,287,100,21 |
||
| 23 | CheckBox 20,14,90,14,"Ref",.CompRef |
||
| 24 | CheckBox 20,35,90,14,"Value",.CompValue |
||
| 25 | CheckBox 20,56,90,14,"Decal",.CompDecal |
||
| 26 | CheckBox 20,77,90,14,"Type",.CompType |
||
| 27 | CheckBox 20,98,90,14,"Side",.CompSide |
||
| 28 | CheckBox 20,119,90,14,"Height",.CompHeight |
||
| 29 | CheckBox 20,140,90,14,"Position",.CompPosition |
||
| 30 | GroupBox 150,7,150,70," Unit for position",.GroupBox1 |
||
| 31 | OptionGroup .UnitSelect |
||
| 32 | OptionButton 170,28,90,14,"metric",.UnitMetric |
||
| 33 | OptionButton 170,49,90,14,"mils",.UnitMils |
||
| 34 | GroupBox 150,91,150,63,"Side",.GroupBox2 |
||
| 35 | CheckBox 170,105,90,14,"TOP",.SideTop |
||
| 36 | CheckBox 170,126,90,14,"BOTT",.SideBott |
||
| 37 | CheckBox 350,105,130,14,"Skip zero height",.ZeroHeight |
||
| 38 | GroupBox 20,189,450,42,"Directory" |
||
| 39 | Text 40,210,310,14,PathName$,.Directory |
||
| 40 | PushButton 360,203,90,21,"browse ...",.browse |
||
| 41 | TextBox 30,252,440,21,.FileName |
||
| 42 | CancelButton 360,287,100,21 |
||
| 43 | CheckBox 350,126,110,14,"To Excel",.ToExcel |
||
| 44 | GroupBox 330,7,140,70,"Type",.GroupBox3 |
||
| 45 | CheckBox 350,28,90,14,"SMD",.TypeSMD |
||
| 46 | CheckBox 350,49,90,14,"KLASIC",.TypeKLASIC |
||
| 47 | CheckBox 20,161,100,14,"Orientation",.CompOrientation |
||
| 48 | End Dialog |
||
| 49 | Dim dlg As UserDialog |
||
| 50 | 'defaultni nastaveni dialogu |
||
| 51 | dlg.FileName$="automat.txt" |
||
| 52 | dlg.CompRef=1 |
||
| 53 | dlg.CompValue=1 |
||
| 54 | dlg.CompDecal=1 |
||
| 55 | dlg.CompType=1 |
||
| 56 | dlg.CompSide=1 |
||
| 57 | dlg.CompHeight=0 |
||
| 58 | dlg.CompPosition=1 |
||
| 59 | dlg.CompOrientation=1 |
||
| 60 | dlg.UnitSelect=1 |
||
| 61 | dlg.SideTop=1 |
||
| 62 | dlg.SideBott=1 |
||
| 63 | dlg.TypeKLASIC=1 |
||
| 64 | dlg.TypeSMD=1 |
||
| 65 | dlg.ToExcel=1 |
||
| 66 | dlg.ZeroHeight=0 |
||
| 67 | Dialog dlg |
||
| 68 | |||
| 69 | file = PathName & "\" & dlg.FileName |
||
| 70 | |||
| 71 | ' otevri textovy soubor |
||
| 72 | On Error GoTo NotOpen |
||
| 73 | Open file For Output As #1 |
||
| 74 | |||
| 75 | ' hlavicka souburu |
||
| 76 | If dlg.CompRef=1 Then Print #1, "Ref"; Space(10-Len("Ref")); |
||
| 77 | If dlg.CompValue=1 Then Print #1, "Value"; Space(20-Len("Value")); |
||
| 78 | If dlg.CompDecal=1 Then Print #1, "Footprint"; Space(50-Len("Footprint")); |
||
| 79 | If dlg.CompType=1 Then Print #1, "Type" ; Space(10-Len("Type")); |
||
| 80 | If dlg.CompSide=1 Then Print #1, "Layer"; Space(10-Len("Layer")); |
||
| 81 | 'If dlg.CompHeight=1 Then Print #1, "Height"; Space(10-Len("Height")); |
||
| 82 | |||
| 83 | If dlg.compPosition=1 Then |
||
| 84 | If dlg.UnitSelect=1 Then |
||
| 85 | Print #1, " X [mils]"; Space(30-Len(" X [mils]")); |
||
| 86 | Print #1, " Y [mils]"; Space(30-Len(" Y [mils]")); |
||
| 87 | End If |
||
| 88 | If dlg.UnitSelect=0 Then |
||
| 89 | Print #1, " X [mm]"; Space(30-Len(" X [mm]")); |
||
| 90 | Print #1, " Y [mm]"; Space(30-Len(" Y [mm]")); |
||
| 91 | End If |
||
| 92 | End If |
||
| 93 | If dlg.CompOrientation=1 Then Print #1, "Orientation [DEG]"; Space(20-Len("Orientation [DEG]")); |
||
| 94 | |||
| 95 | Print #1,"" 'odradkovani |
||
| 96 | |||
| 97 | ' pro zvyseni rychlosti |
||
| 98 | LockServer |
||
| 99 | |||
| 100 | ' vlastni vyplneni tabulky |
||
| 101 | For Each nextComp In ActiveDocument.Components |
||
| 102 | |||
| 103 | On Error Resume Next 'pokud neni Atribut Geometry.Height definovan,soucastku zapis do tabulky |
||
| 104 | If dlg.ZeroHeight =1 And ZeroItem(nextComp.Attributes("Geometry.Height").value)="TRUE" Then GoTo SkipItem ' preskoc polzky s nulovou vyskou |
||
| 105 | |||
| 106 | If dlg.SideTop=0 And ActiveDocument.LayerName(nextComp.layer)="Top" Then GoTo SkipItem 'preskoc soucastky na strane soucastek |
||
| 107 | If dlg.SideBott=0 And ActiveDocument.LayerName(nextComp.layer)="Bottom" Then GoTo SkipItem 'preskoc soucastky na strane spoju |
||
| 108 | If dlg.TypeSMD=0 And nextComp.IsSMD=True Then GoTo SkipItem |
||
| 109 | If dlg.TypeKLASIC=0 And nextComp.IsSMD=False Then GoTo SkipItem |
||
| 110 | |||
| 111 | If dlg.CompRef=1 Then Print #1, nextComp.Name; Space$(10-Len(nextComp.Name)); |
||
| 112 | |||
| 113 | If dlg.CompValue=1 Then |
||
| 114 | On Error GoTo NotExist ' skoc, pokud atribut "value" neni definovan |
||
| 115 | Print #1, nextComp.Attributes("Value").value; Space$(20-Len(nextComp.Attributes("Value").value)); |
||
| 116 | End If |
||
| 117 | |||
| 118 | If dlg.CompDecal=1 Then Print #1, nextComp.Decal; Space$(50-Len(nextComp.Decal)); |
||
| 119 | If dlg.CompType=1 Then |
||
| 120 | If nextComp.IsSMD Then |
||
| 121 | Print #1,"SMD"; Space$(10-Len("SMD")); |
||
| 122 | End If |
||
| 123 | If Not nextComp.IsSMD Then |
||
| 124 | Print #1,"KLASIC"; Space(10-Len("KLASIC")); |
||
| 125 | End If |
||
| 126 | End If |
||
| 127 | |||
| 128 | If dlg.CompSide=1 Then Print #1, ActiveDocument.LayerName(nextComp.layer); Space$(10-Len(ActiveDocument.LayerName(nextComp.layer))); |
||
| 129 | |||
| 130 | If dlg.CompPosition=1 Then |
||
| 131 | If dlg.UnitSelect=1 Then 'jednotky jsou mils |
||
| 132 | Print #1, Str(Int(nextComp.PositionX(2))); Space$(30-Len(Str(Int(nextComp.PositionX)))); |
||
| 133 | Print #1, Str(Int(nextComp.PositionY(2))); Space$(30-Len(Str(Int(nextComp.PositionY)))); |
||
| 134 | End If |
||
| 135 | If dlg.UnitSelect=0 Then 'jednoky jsou mm |
||
| 136 | Print #1, Str((nextComp.PositionX(4))); Space$(30-Len(Str((nextComp.PositionX)))); |
||
| 137 | Print #1, Str((nextComp.PositionY(4))); Space$(30-Len(Str((nextComp.PositionY)))); |
||
| 138 | End If |
||
| 139 | End If |
||
| 140 | If dlg.CompOrientation=1 Then |
||
| 141 | Print #1, Str(Int(nextComp.Orientation)); Space$(30-Len(Str(Int(nextComp.Orientation)))); |
||
| 142 | End If |
||
| 143 | |||
| 144 | Print #1,"" 'odradkovani |
||
| 145 | SkipItem: |
||
| 146 | Next nextComp |
||
| 147 | |||
| 148 | UnlockServer |
||
| 149 | |||
| 150 | ' zavri textovy soubor |
||
| 151 | Close #1 |
||
| 152 | If dlg.ToExcel=1 Then ToExcel(file) 'export do excelu |
||
| 153 | End |
||
| 154 | |||
| 155 | NotExist: |
||
| 156 | ' atribut neni definovan, do tabulky zapis "NOTEXIST a jdi na dalsi polozku |
||
| 157 | Print #1, "NOTEXIST"; Space$(20-Len("NOTEXIST")); |
||
| 158 | Resume Next |
||
| 159 | |||
| 160 | NotOpen: |
||
| 161 | MsgBox "Not create files" |
||
| 162 | End Sub |
||
| 163 | ' otevre v Excelu soubor se jmenem v file |
||
| 164 | Sub ToExcel(file) |
||
| 165 | ' otevri excel a natahni soubor |
||
| 166 | On Error GoTo noExcel |
||
| 167 | Dim excelApp As Object |
||
| 168 | Set excelApp = CreateObject("Excel.Application") |
||
| 169 | On Error GoTo 0 |
||
| 170 | excelApp.Visible = True |
||
| 171 | excelApp.Workbooks.OpenText FileName:= file |
||
| 172 | excelApp.Rows("1:1").Select |
||
| 173 | With excelApp.Selection |
||
| 174 | .Font.Bold = True |
||
| 175 | .Font.Italic = True |
||
| 176 | End With |
||
| 177 | excelApp.Range("A1").Select |
||
| 178 | Set excelApp = Nothing |
||
| 179 | End |
||
| 180 | |||
| 181 | noExcel: |
||
| 182 | ' excel neni, otevri Notepad |
||
| 183 | Shell "Notepad " & file, 3 |
||
| 184 | End Sub |
||
| 185 | |||
| 186 | 'zjisti, zda dany string obsahuje nulove ciso |
||
| 187 | 'pokud string obsahuje jen nuly a dalsi neciselne znaky, vraci "TRUE" |
||
| 188 | 'pokud string obsahuje i jine cislice nebo jen neciselne znaky, vraci "FALSE" |
||
| 189 | Function ZeroItem$(Data$) |
||
| 190 | ZeroItem$="FALSE" |
||
| 191 | For i=1 To Len(Data$) |
||
| 192 | If Not(Mid(Data$,i,1)=" " Or Mid(Data$,i,1)=".") Then |
||
| 193 | |||
| 194 | If Mid(Data$,i,1)="0" Then |
||
| 195 | ZeroItem$="TRUE" |
||
| 196 | Else |
||
| 197 | If Mid(Data$,i,1)>"0" And Mid(Data$,i,1)<="9" Then |
||
| 198 | ZeroItem$="FALSE" |
||
| 199 | i=Len(Data$) |
||
| 200 | Else |
||
| 201 | i=Len(Data$) |
||
| 202 | End If |
||
| 203 | End If |
||
| 204 | End If |
||
| 205 | Next i |
||
| 206 | End Function |
||
| 207 | 'obsluzna fce dialogu |
||
| 208 | Function CallbackFunc%(DlgItem$, Action%, SuppValue%) |
||
| 209 | |||
| 210 | Select Case Action% |
||
| 211 | |||
| 212 | Case 2 'stisknuto nejake tlacitko, nebo neco vybrano v boxech |
||
| 213 | If DlgItem$="browse" Then 'stisknuto tlacitko browse |
||
| 214 | s$=BrowseDirectory |
||
| 215 | If s<>"" Then |
||
| 216 | PathName=s |
||
| 217 | DlgText "Directory",PathName 'nahrad puvodni obsah okenka Path v dialogu |
||
| 218 | CallbackFunc=True ' refresuj dialog |
||
| 219 | End If |
||
| 220 | End If |
||
| 221 | If DlgItem$="Cancel" Then End 'zkonci script |
||
| 222 | End Select |
||
| 223 | End Function |
||
| 224 | ' vrati vybranou cestu jako string |
||
| 225 | Function BrowseDirectory As String |
||
| 226 | Dim bi As BROWSEINFO, s As String*256, pos |
||
| 227 | bi.ulFlags = 9 |
||
| 228 | bi.hwndOwner = dlgHandle |
||
| 229 | Dim pidl As Long |
||
| 230 | pidl = SHBrowseForFolder(bi) |
||
| 231 | If pidl <> 0 Then |
||
| 232 | If SHGetPathFromIDList(pidl, s) <> 0 Then |
||
| 233 | pos = InStr(s, Chr(0)) |
||
| 234 | BrowseDirectory = Left(s, pos-1) |
||
| 235 | End If |
||
| 236 | End If |
||
| 237 | End Function |
Powered by WebSVN v2.8.3