注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

Mister.Hu(巷里人家)

Go abroad!

 
 
 

日志

 
 
关于我

A campus photograph palyer,an enthusiastic reader,a solitary writer,a future traffic engineer.

网易考拉推荐

Smartparking Simulation by VBS-VISSIM_COM  

2015-11-24 18:35:18|  分类: Senior |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
'==========================================================================
'The code following is my first use of VISSIM_COM,to solve the problem of the smartparking in Innovative Class.
'We should be informed that only the copyrighted software can run this code successfully.The VISSIM 4.30 is 'recommended as its cracked version can be downloaded now.But remember to change the time to 2007-12-31.
'The code mainly trys to change the 3Dbarrier automatically,the same to the Counterboard(not  successful though).
'The V3d model cannot be open or manufacture because the model need money to purchase.So the statue of the V3d 'models are not  certain.
'In VISSIM,we should set decectors and signalcontrollers correspondingly.A trace responds to three decectors and 'two signalcontrollers totally.
'==========================================================================
'==========================================================================
' VBScript sample for VISSIM
' Copyright (C) PTV AG. All rights reserved.
' Sven Beller, Vidal Roca 2006-07-25
'
' This code demonstrates the use of the following interfaces for the
' simulation of a car park with access control and available free places
' information:
' - ISignalControllers and ISignalGroups
' - IDetectors: Use of the attributes PRESENCE and IMPULSE
' - IStaticObjects: Use of the attribute STATE to change the 3D state 
'   during simulation time
'==========================================================================

'constants
'==========================================================================
Const GREEN = 2, RED = 3
Const OPENEDTIME = 5 'opened barrier time
Const NPLACES = 11 'number of parkingplaces
'==========================================================================

'global variables
'==========================================================================
Dim Vis, Sim, SgCtrls, Dets, StObjs
Dim SgGrps(3), DetsIn(3), DetsPass(3), DetsOut(3) 'entrance/exit control
Dim VehEntering(3) 'entrance processing flags
Dim VehParked(3) 'entrance processing flags
Dim Barriers(3), BarrierOpening(3), BarrierClosing(3) 'barriers control
Dim CtrName(3, 2) ' static object file name of counters
'==========================================================================

'main program
'==========================================================================
'Load the VISSIM program
Set Vis = CreateObject("VISSIM.Vissim")'VISSIM.Vissim is an ActiveX control
Set Sim = Vis.Simulation
Set SgCtrls = Vis.Net.SignalControllers
Set StObjs = Vis.Net.StaticObjects

'Load Net 
sPath = WScript.ScriptFullname 'Wscript.ScriptFullName 返回本vbs脚本的完整路径; 如 C:\My Folder\test.vbs;Wscript.ScriptName 返回本vbs脚本的文件名; 如 test.vbs
sPath = Left(sPath, Len(sPath) - Len(WScript.Scriptname))'Now sPath=C:\My Folder
Vis.LoadNet(sPath + "..\CarPark.inp")
Vis.LoadLayout(sPath + "..\CarPark.ini")

'Initialize
call Initialize

'start simulating
For SimStep = 1 To Sim.Period * Sim.Resolution'Sim.Period * Sim.Resolution means the final simstep
Sim.RunSingleStep

call ControlEntrances
call ControlBarriers
call CountOccupiedSpaces
'update counters every second
If (SimStep Mod Sim.Resolution) = 0 Then
call UpdateCounters
End If
Vis.DoEvents 'allow VISSIM to handle its events
Next
'the main program is end,the following is the definition of serval function==========================================================================

'initialize global variables
'==========================================================================
Sub Initialize
' initialize signal controllers
For i = 1 To 3
Set SgGrps(i) = SgCtrls.GetSignalControllerByNumber(i).SignalGroups.GetSignalGroupByNumber(1)'the signalcontroller in Vissim has two layer,the controller and the groups.
SgGrps(i).AttValue("TYPE") = RED'the initial state of all signal is red
Next

'initialize barriers
Set Barriers(1) = StObjs.GetStaticObjectByName("Barrier01.v3d")'gain the v3d models of barriers
Set Barriers(2) = StObjs.GetStaticObjectByName("Barrier02.v3d")
Set Barriers(3) = StObjs.GetStaticObjectByName("Barrier03.v3d")
For i = 1 To 3
Barriers(i).AttValue("STATE") = 0
BarrierOpening(i) = False
BarrierClosing(i) = False
Next

'initialze detectors
For i = 1 To 3
Set Dets = SgCtrls.GetSignalControllerByNumber(i).Detectors'each signalcontroller has one detector
Set DetsIn(i) = Dets.GetDetectorByNumber(11)
Set DetsPass(i) = Dets.GetDetectorByNumber(12)
Set DetsOut(i) = Dets.GetDetectorByNumber(91)
VehEntering(i) = False
Next

'initialze occupied spaces counters
For i = 1 To 3
VehParked(i) = 0
Next

'counter names
CtrName(1, 1) = "Counter_P01a.v3d"
CtrName(1, 2) = "Counter_P01b.v3d"
CtrName(2, 1) = "Counter_P02a.v3d"
CtrName(2, 2) = "Counter_P02b.v3d"
CtrName(3, 1) = "Counter_P03a.v3d"
CtrName(3, 2) = "Counter_P03b.v3d"
End Sub
'==========================================================================

'control detector for the entrance, pass and exit
'==========================================================================
Sub ControlEntrances()
'Through all entrances
For i = 1 To 3
'if vehicle is on the entrance and no entrance is being processed 
'then start enter process
If DetsIn(i).AttValue("PRESENCE") And Not VehEntering(i) Then'AttValue() means return a vissim attribute.
VehEntering(i) = True 'start entrance process
BarrierOpening(i) = True 'start open barrier process
End If

'did the entering vehicle entered?
If VehEntering(i) And DetsPass(i).AttValue("PRESENCE") Then
SgGrps(i).AttValue("TYPE") = RED 'don't allow to enter
BarrierClosing(i) = True 'start closing barrier
End If
Next 'Through all entrances
End Sub
'==========================================================================

'open and close barriers appropriately
'==========================================================================
Sub ControlBarriers()
'through all barriers
For i = 1 To 3
If BarrierOpening(i) Then 'opening barrier,related to ControlEntrances above.
If Barriers(i).AttValue("STATE") < Barriers(i).AttValue("NSTATES") - 2 Then'state=0 means closed,state=1 means open.nstates=3.
Barriers(i).AttValue("STATE") = Barriers(i).AttValue("STATE") + 1 'opening
End If
If Barriers(i).AttValue("STATE") = Barriers(i).AttValue("NSTATES") - 2 Then 'barrier has been opened
BarrierOpening(i) = False
SgGrps(i).AttValue("TYPE") = GREEN 'allow vehicle to enter
End If
End If

If BarrierClosing(i) Then 'closing barrier
If Barriers(i).AttValue("STATE") > 0 Then
Barriers(i).AttValue("STATE") = Barriers(i).AttValue("STATE") - 1 'closing
End If
If Barriers(i).AttValue("STATE") = 0 Then 'barrier closed
BarrierClosing(i) = False
VehEntering(i) = False
End If
End If
Next 'through all barriers
End Sub
'==========================================================================

'update occupied places counters
'==========================================================================
Sub CountOccupiedSpaces()
'through all car park areas
For i = 1 To 3
If DetsPass(i).AttValue("IMPULSE") And (SimStep Mod Sim.Resolution) = 0 Then
VehParked(i) = VehParked(i) + 1
End If
If DetsOut(i).AttValue("IMPULSE") And (SimStep Mod Sim.Resolution) = 0 Then
VehParked(i) = VehParked(i) - 1
End If
Next 'Through all entrances
End Sub
'==========================================================================

'update digit counters
'==========================================================================
Sub UpdateCounters()
'through all counters,to update the numbers on the board.
For i = 1 To 3
digit1 = (NPLACES - VehParked(i)) Mod 10'个位数
digit2 = ((NPLACES - VehParked(i)) \ 10) Mod 10'十位数
If digit2 = 0 Then
digit2 = 10 'state 10 = black instead of 0
End If

For ii = 1 to StObjs.count
Set counter = StObjs(ii)
If counter.Name = CtrName(i, 1) Then 'first digit (least significant)
counter.AttValue("STATE") = digit1
End If
If counter.Name = CtrName(i, 2) Then 'second digit (10^1)
counter.AttValue("STATE") = digit2
End If
Next
Next 'through all counters
End Sub
'==========================================================================

  评论这张
 
阅读(51)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2016