|
Set App = CreateObject( "CT.application" )
Set Prj = App.CreateJobObject
Set Sht = Prj.CreateSheetObject
Set Att = Prj.CreateAttributeObject
Set Txt = Prj.CreateTextObject
Set Gra = Prj.CreateGraphObject
Set Dev = Prj.CreateDeviceObject
Set Con = Prj.CreateConnectionObject
Set sym = Prj.CreateSymbolObject
Set Dev1 = Prj.CreateDeviceObject
Set Pin1 = Prj.CreatePinObject
Set Dev2 = Prj.CreateDeviceObject
Set Pin2 = Prj.CreatePinObject
Set wir = Prj.CreatePinObject
Set bnd = prj.CreateBundleObject
Set cmp = prj.CreateComponentObject
Set cab = prj.CreatePinObject
Set Excel = CreateObject("Excel.Application")
app.ClearOutputWindow
app.AvoidAutomaticClosing
If( prj.Getid = 0 ) Then
app.PutWarning 1, "nichts geöffnet"
Set app = Nothing
WScript.Quit
End If
If ( Prj.GetSheetIds ( shtids ) = 0 ) Then
app.putwarning 1, keine blätter"
Set app = Nothing
WScript.Quit
End If
ndevs = Prj.GetAllDeviceCount
if( ndevs < 1 ) then
App.puterror 1, "Keine Bauteile im Projekt."
wscript.quit
end if
Prj.GetAllDeviceIds devIds
for d = 1 to Ubound (devIds)
Dev.SetId devIds (d)
list dev
next
wscript.quit
Function list(ldev)
devtyp = "Unknown"
If ldev.IsBlock then devtyp = "Block"
if ldev.IsDevice Then devtyp = "Device"
End Function
if ldev.IsTerminal then devtyp = "Terminal"
if ldev. IsTerminalBlock then devtyp = "Terminal Block"
if ldev.IsCable then devtyp = "Cable"
if ldev.IsConnecotr then devtyp = "Connector"
App.PutInfo 0, " "
App.PutInfo 0, devtyp & " [" & ldev.GetId & "]"
App.PutInfo 0, " -------------------------------------------"
App.PutInfo 0, " Name: " & ldev.getname
App.PutInfo 0, " Assigment: " & ldev.GetAssigment
App.PutInfo 0, " Location: " & ldev.GetLocation
Next
MsgBox "STAP Verbindungstabelle wird erstellt!", 0,"STAP Verbindungstabelle"
Excel.Workbooks.Add
Excel.Cells( 1, 1 ) = "LTG-NR;QSCHN;TYP;FARB;MLTG;AUFS-ORT V;ORT V;BTM V;ANS V;AUFS-ORT N;ORT N;BTM N;ANS N;BUND;STRANG;BG;LTG-KAT;ZST;PLAN"
'kann gelöscht werden ist nur für testing
Excel.Cells( 2, 1 ) = "Leitung"
Excel.Cells( 2, 2 ) = "mm²"
Excel.Cells( 2, 3 ) = "TYP"
Excel.Cells( 2, 4 ) = "FARBen"
Excel.Cells( 2, 5 ) = "MTG"
Excel.Cells( 2, 6 ) = "AUFS-ORT X"
Excel.Cells( 2, 7 ) = "ORT X"
Excel.Cells( 2, 8 ) = "BTM V"
Excel.Cells( 2, 9 ) = "ANS V"
Excel.Cells( 2, 10 ) = "AUFS-ORT Z"
Excel.Cells( 2, 11 ) = "ORT N"
Excel.Cells( 2, 12 ) = "BTM N"
Excel.Cells( 2, 13 ) = "ANS N"
Excel.Cells( 2, 14 ) = "BUND"
Excel.Cells( 2, 15 ) = "STRANG"
Excel.Cells( 2, 16 ) = "BG"
Excel.Cells( 2, 17 ) = "KAT"
Excel.Cells( 2, 18 ) = "ZST"
Excel.Cells( 2, 19 ) = "PLAN"
'kann gelöscht werden ist nur für testing
prj.GetAllDeviceIds DevIds
for d = 1 to Ubound (DevIds)
dev.SetId DevIds(d)
' list dev
Next
cabs = prj.GetCableCount
prj.GetCableIds cabids
for c = 1 to cabs
dev.SetId cabids(c)
wirs = dev.GetPinCount
dev.GetPinIds wirids
for w = 2 to wirs
wir.SetId wirids(w)
pin1.SetId wir.GetEndPinId( 1 )
dev1.SetId Pin1.GetId
pin2.SetId wir.GetEndPinId( 2 )
dev2.SetId Pin2.GetId
Excel.Cells(w+1, 1).Value = wir.GetName
Excel.Cells(w+1, 2).Value = wir.GetCrossSection
Excel.Cells(w+1, 3).Value = dev.GetAttributeValue 'prüfen +KK Ort
Excel.Cells(w+1, 4).Value = wir.GetColourDescription
Excel.Cells(w+1, 5).Value = dev.GetName
Excel.Cells(w+1, 6).Value = dev1.GetAttributeValue
Excel.Cells(w+1, 7).Value = dev1.GetLocation
Excel.Cells(w+1, 8).Value = dev1.GetName
Excel.Cells(w+1, 9).Value = Pin1.GetName
Excel.Cells(w+1, 10).Value = dev2.GetAttributeValue
Excel.Cells(w+1, 11).Value = dev2.GetLocation
Excel.Cells(w+1, 12).Value = dev2.GetName
Excel.Cells(w+1, 13).Value = Pin2.GetName
Excel.Cells(w+1, 14).Value = wir.GetAttributeValue
Excel.Cells(w+1, 15).Value = wir.GetAttributeValue
Excel.Cells(w+1, 16).Value = "" 'info fehlen???
Excel.Cells(w+1, 17).Value = dev.GetAttributeValue
Excel.Cells(w+1, 18).Value = dev.GetAttributeValue
Excel.Cells(w+1, 19).Value = wir.GetName 'prüfen
Next
Next
MsgBox "STAP Verbindungstabelle erstellt!", 0,"STAP Verbindungstabelle"
Excel.Visible = 1
Set Excel = nothing
|