对于给定的 3D 气体填充几何，本示例中生成一个新的方案，其中，几何已按照原始方案中的定义导出，且所有完全被气体封闭的单元都被移除。
'%RunPerInstance
'@
'@ DESCRIPTION
'@ Given a 3D Gas Filled Geometry
'@ This command will produce a new study (new_study(_x)) with the following
'@ The Geometry will be exported as defined in the original study
'@ The Elements wholly enclosed by gas will be removed
'@
'@ SYNTAX
'@ RemoveGasCore
'@
'@ PARAMETERS
'@
'@ DEPENDENCIES/LIMITATIONS
'@ May be slow on large models (a number of steps have been taken to imporve the script performance)
'@ Will only work with 3D Geometries
'@ Minimal error checking
'@@
Option Explicit
SetLocale("en-us")
' Initialize Synergy
Dim Synergy
Dim SynergyGetter
On Error Resume Next
Set SynergyGetter = GetObject(CreateObject("WScript.Shell").ExpandEnvironmentStrings("%SAInstance%"))
On Error GoTo 0
If (Not IsEmpty(SynergyGetter)) Then
Set Synergy = SynergyGetter.GetSASynergy
Else
Set Synergy = CreateObject("synergy.Synergy")
End If
' Check an active study is open
Dim StudyDoc
Set StudyDoc = Synergy.StudyDoc
If (StudyDoc is Nothing) Then
WScript.Echo "ERROR: No active study"
WScript.Quit
End If
' Read Model Tets and Nodes
' using thisd class structure is more efficient than using the Synergy API call
' to perform the equivalent functionality
' Essentially the study gets exported as an ASCII Udm and is processed natively in vbscript
Dim Nodes, Tets
Set Nodes = New MeshNodes
Set Tets = New MeshTets
' Read the Last Gas Core Result
Dim Indp, Entity, NodeResult, PlotMgr, IndpValues
Set PlotMgr = Synergy.PlotManager
Set IndpValues = Synergy.CreateDoubleArray()
If Not (PlotMgr.GetIndpValues(1992, IndpValues)) Then
WScript.Echo "ERROR: Unable to find Gas Core result"
WScript.Quit
End If
Set Indp = Synergy.CreateDoubleArray()
Indp.AddDouble IndpValues.Val( IndpValues.Size - 1 )
Set Entity = Synergy.CreateIntegerArray()
Set NodeResult = Synergy.CreateDoubleArray()
PlotMgr.GetScalarData 1992, Indp, Entity, NodeResult
Dim vbArrNode, vbArrNodeResult
vbArrNode = Entity.ToVBSArray()
vbArrNodeResult = NodeResult.ToVBSArray()
' Create an indexed array of nodes with Gas true = Gas, false= no Gas
Dim lSize, I, ll
lSize = Tets.GetHighNode
Dim Gas()
ReDim Gas(lSize+1)
For I = 0 To UBound(Gas)
Gas(I) = False
Next
For I = 0 To UBound(vbArrNode)
If vbArrNodeResult(I)> 0.0 Then
ll = vbArrNode(I)
Gas(ll) = True
End if
Next
' If all 4 nodes on a tet have contain Gas then the Element is included in the list to delete
' Note this logic can be changed to include partially filled elements
Dim DelElements()
ReDim DelElements(Tets.GetNumTets)
Dim count
count = 0
For I = 0 To Tets.GetNumTets-1
Dim NID, EID
NID = CLng(Tets.GetTetNode(I,0))
If Gas(NID) Then
NID = CLng(Tets.GetTetNode(I,1))
If Gas(NID) Then
NID = CLng(Tets.GetTetNode(I,2))
If Gas(NID) Then
NID = CLng(Tets.GetTetNode(I,3))
If Gas(NID) Then
EID = Tets.GetTetID(I)
DelElements(count) = EID
count = count + 1
End If
End If
End If
End if
Next
Dim NumDelElements
NumDelElements = count
StudyDoc.SaveAs "part_minus_gas_core"
' Delete the elements in blocks of 20000 Elements to avoid using too much memory
Dim MeshEditor, First, Last, Increment, Str, DelEntList
Set MeshEditor = Synergy.MeshEditor()
Increment = 20000
First = 0
Last = Increment
If (Last) > NumDelElements Then
Last = NumDelElements
End If
While (First < Last)
Str = ""
For I = First To Last-1
Str = Str + "TE" & Cstr(DelElements(I)) + " "
Next
Set DelEntList = MeshEditor.CreateEntityList()
DelEntList.SelectFromString(Str)
MeshEditor.Delete(DelEntList)
First = Last
Last = Last + Increment
If (Last) > NumDelElements Then
Last = NumDelElements
End if
Wend
WScript.Echo "*** Elements which were 100% filled with gas have been removed ***"
' ---- Splits a line into words properly
Function SmartSplit(Str)
Str = Replace(Str, "{", " ")
Str = Replace(Str, "}", " ")
SmartSplit = Split(Trim(Str))
End Function
' ---- Gets temporary folder location
Function GetTempPath()
Const TemporaryFolder = 2
Dim FS
Set FS = CreateObject("Scripting.FileSystemObject")
Set Temp = FS.GetSpecialFolder(TemporaryFolder)
GetTempPath = Temp.Path
End Function
Function GetTempUdm()
Const TemporaryFolder = 2
Dim FS, Temp, lName
Set FS = CreateObject("Scripting.FileSystemObject")
Set Temp = FS.GetSpecialFolder(TemporaryFolder)
lName = ""
while lName = ""
lName = Temp.Path + "\" + FS.GetTempName()
LName = Replace(lName, ".tmp", ".udm")
If FS.FileExists(lName) Then
lName = ""
End If
Wend
GetTempUdm = lName
End Function
' ---- Tet class
Class Tet
Public ID, NodeLabels(3)
Public Function Read(Str)
Dim Words, RetVal
RetVal = False
Words = SmartSplit(Str)
If UBound(Words) = 12 Then
ID = CLng(Words(1))
Dim I
For I = 0 To 3
NodeLabels(I) = CLng(Words(I+9))
Next
RetVal = True
End If
Read = RetVal
End Function
Private Sub Class_Initialize
ID = 0
Dim I
For I = 0 To 3
NodeLabels(I) = 0
Next
End Sub
End Class
' ---- Node class
Class Node
Public ID
Private Sub Class_Initialize
ID = 0
End Sub
End Class
' ---- Mesh Nodes class
Class MeshNodes
Public Function GetNode(I)
Set RetVal = Nothing
If I >= 0 And I <= HighNode Then
RetVal = Nodes(I)
End If
Set GetNode = RetVal
End Function
Public Function GetHighNode()
GetHighNode = HighNode
End Function
Public Function GetNodeID(I)
GetNodeID = Nodes(I).ID
End Function
Public Sub SetHighNode(Str)
Words = SmartSplit(Str)
If UBound(Words) = 8 Then
ID = CLng(Words(1))
If ID > HighNode Then
HighNode = ID
End If
End If
End Sub
Private Nodes(), HighNode
Private Sub Class_Initialize
HighNode = 0
End Sub
End Class
' ---- Mesh Tets class
Class MeshTets
Public Function GetTet(I)
Set RetVal = Nothing
If I >= 0 And I < NumTets Then
RetVal = Tets(I)
End If
Set GetTet = RetVal
End Function
Public Function GetTetID(I)
GetTetID = Tets(I).ID
End Function
Public Function GetTetNode(I,J)
Dim RetVal
RetVal = -1
If J >= 0 And J <= 3 Then
RetVal = Tets(I).NodeLabels(J)
End If
GetTetNode = RetVal
End Function
Private Sub SetNumTets(Str)
Dim Words
Words = SmartSplit(Str)
If UBound(Words) = 1 Then
NumTets = CLng(Words(1))
End if
End Sub
Public Function GetNumTets()
GetNumTets = NumTets
End Function
Sub ReadData (FileName)
Const ForReading = 1
Dim FS, File, Line, nTets
Set FS = CreateObject("Scripting.FileSystemObject")
Set File = FS.OpenTextFile(FileName, ForReading)
While NumTets = 0
Line = File.ReadLine
If InStr(Line, "NOT4{") = 3 Then
SetNumTets(Line)
End if
Wend
ReDim Tets(NumTets)
nTets = 0
Line = File.ReadLine
While Not InStr(Line,"TET4{") = 1
If InStr(Line, "NODE{") = 1 Then
SetHighNode(Line)
End If
Line = File.ReadLine
Wend
While InStr(Line,"TET4{") = 1
Dim TetData
Set TetData = New Tet
If TetData.Read(Line) Then
Set Tets(nTets) = TetData
nTets = nTets + 1
End If
Line = File.ReadLine
Wend
File.Close
FS.DeleteFile FileName
End Sub
Public Sub SetHighNode(Str)
Dim Words, ID
Words = SmartSplit(Str)
If UBound(Words) = 8 Then
ID = CLng(Words(1))
If ID > HighNode Then
HighNode = ID
End If
End If
End Sub
Public Function GetHighNode()
GetHighNode = HighNode
End Function
Private Tets(), NumTets, HighNode, UdmName
Private Sub Class_Initialize
NumTets = 0
HighNode = 0
Dim FS
Set FS = CreateObject("Scripting.FileSystemObject")
UdmName = GetTempUdm()
Synergy.Project.ExportModel UdmName
ReadData UdmName
End Sub
End Class