tiagojk11
Newbie level 5
Hii everyone,
When I click 3Dpolygon from Curves menu, a window offer a option to load xyz data from .txt file. It's very good!!! But I have hundreds of files to load and it's borring and wasted time to load one by one...
So, I'm trying to program a macro for CST import several .txt files with xyz data to create a 3Dpolygon from each file and cover planar curve to each resulting curve. Each file has 200 points. It's my first time working with VBA and I'm with dificulties to do this task. Of course, i am trying modify a example macro from CST that imports CAD files to do this also with .txt file but it don't work, I don't know how to hand the xyz data to create 3Dpolygon.
Could someone help me? Thanks very much!
Below a tried code.
' File \ Import multiple txt files
' This macro imports txt files with xyz data, located within a certain folder, without manually importing each single file.
' Transform each file to a 3Dpolygon and Cover Planar Curve
'-----------------------------------------------------------------------------------------------------------------------------
' 13-Jul-2012
'-----------------------------------------------------------------------------------------------------------------------------
Option Explicit
'#include "vba_globals_all.lib"
Public Enum txtformat
TXT
End Enum
Public VBA_Object(30) As String
Public ext(30) As String
Public datafile_cadfiles As String
Sub Main ()
VBA_Object(TXT) = "TXT"
ext(txt) = "*.txt"
Begin Dialog UserDialog 610,210,"Import multiple TXT files",.DialogFunc ' %GRID:10,7,1,1
GroupBox 10,7,590,84,"",.GroupBox1
Text 20,21,100,14,"Folder:",.Text1
PushButton 500,21,90,21,"Browse...",.Browse
Text 320,56,60,14,"File Ext.",.Text2
TextBox 390,56,100,21,.file_extension
TextBox 120,21,370,21,.folder
DropListBox 120,56,130,28,VBA_Object(),.Format
PushButton 20,182,90,21,"Import Files",.Import
GroupBox 10,105,590,70,"Options (if supported by selected format)",.GroupBox2
CancelButton 120,182,90,21
Text 20,56,90,14,"CAD Format:",.Text3
CheckBox 280,126,230,14,"Scale to current unit",.ScaleToCurrentUnit
CheckBox 30,147,90,14,"Healing",.Healing
CheckBox 30,126,180,14,"Import attributes",.ImportAttributes
End Dialog
Dim dlg As UserDialog
dlg.file_extension = "*.txt"
dlg.ScaleToCurrentUnit = 0
dlg.Healing = 0
dlg.ImportAttributes = 1
Do
dlg.folder = GetProjectPath("Root")
If (Dialog(dlg) = 0) Then Exit All
Loop Until (dlg.folder <> "")
Dim sRootPath As String, n_cadfiles As Integer, sfilename As String, sattr As String
sRootPath = dlg.folder
If dlg.ImportAttributes Then
sattr = "True"
Else
sattr = "False"
End If
datafile_cadfiles = GetProjectPath("Model3D") + "\list_of_cadfiles.dat"
Open datafile_cadfiles For Output As #1
n_cadfiles = 0
sfilename = FindFirstFile(sRootPath, dlg.file_extension, False)
While (sfilename <> "")
Print #1, sRootPath + "\" + sfilename
n_cadfiles = n_cadfiles + 1
sfilename = FindNextFile
Wend
Close #1
Begin Dialog UserDialog 410,105,"List of CAD files",.DialogFunc3 ' %GRID:10,7,1,1
GroupBox 10,7,390,56,"",.GroupBox1
Text 30,21,330,14,"Searching CAD Files Finished:",.Text1
Text 30,42,340,14,"Number of found CAD Files, to be imported = " + CStr(n_cadfiles),.Text2
PushButton 150,77,120,21,"Import Now",.Delete
PushButton 20,77,120,21,"View/Edit List",.View
CancelButton 280,77,100,21
End Dialog
Dim dlg3 As UserDialog
If (Dialog(dlg3) = 0) Then Exit All
Dim sCommand As String, sVbaObj2 As String
sCommand = ""
Select Case dlg.Format
Case TXT
Open datafile For Output As #1
For iData=1 To nData
Read #1, sarray(iData)
Next iData
Close #1
sCommand = sCommand + " .ScaleToUnit """ + CStr(dlg.ScaleToCurrentUnit) + """" + vbLf
End Select
sCommand = sCommand + " .Read" + vbLf
sCommand = sCommand + "End With" + vbLf
AddToHistory "Import multiple " + VBA_Object(dlg.Format) + " Files", sCommand
End Sub
Function DialogFunc%(Item As String, Action As Integer, Value As Integer)
Dim filename As String, Extension As String, Index As Integer
Select Case Action
Case 1 ' Dialog box initialization
Case 2 ' Value changing or button pressed
Select Case Item
Case "Help"
' StartHelp HelpFileName
DialogFunc = True
Case "Browse"
filename = DlgText("folder") + "\" + "Use this directory"
filename = GetFilePath(filename, "", "", "Choose directory, containing CAD files", 2)
If (filename <> "") Then
DlgText "folder", DirName(filename)
End If
DialogFunc = True
Case "Format"
DlgText "file_extension", ext(Value)
DialogFunc = True
End Select
Case 3 ' ComboBox or TextBox Value changed
Case 4 ' Focus changed
Case 5 ' Idle
End Select
End Function
Function DialogFunc3%(Item As String, Action As Integer, Value As Integer)
Dim filename As String, Extension As String, Index As Integer
Select Case Action
Case 1 ' Dialog box initialization
Case 2 ' Value changing or button pressed
Select Case Item
Case "View"
Shell("notepad.exe " + datafile_cadfiles, 1)
DialogFunc3 = True
End Select
Case 3 ' ComboBox or TextBox Value changed
Case 4 ' Focus changed
Case 5 ' Idle
End Select
End Function
When I click 3Dpolygon from Curves menu, a window offer a option to load xyz data from .txt file. It's very good!!! But I have hundreds of files to load and it's borring and wasted time to load one by one...
So, I'm trying to program a macro for CST import several .txt files with xyz data to create a 3Dpolygon from each file and cover planar curve to each resulting curve. Each file has 200 points. It's my first time working with VBA and I'm with dificulties to do this task. Of course, i am trying modify a example macro from CST that imports CAD files to do this also with .txt file but it don't work, I don't know how to hand the xyz data to create 3Dpolygon.
Could someone help me? Thanks very much!
Below a tried code.
' File \ Import multiple txt files
' This macro imports txt files with xyz data, located within a certain folder, without manually importing each single file.
' Transform each file to a 3Dpolygon and Cover Planar Curve
'-----------------------------------------------------------------------------------------------------------------------------
' 13-Jul-2012
'-----------------------------------------------------------------------------------------------------------------------------
Option Explicit
'#include "vba_globals_all.lib"
Public Enum txtformat
TXT
End Enum
Public VBA_Object(30) As String
Public ext(30) As String
Public datafile_cadfiles As String
Sub Main ()
VBA_Object(TXT) = "TXT"
ext(txt) = "*.txt"
Begin Dialog UserDialog 610,210,"Import multiple TXT files",.DialogFunc ' %GRID:10,7,1,1
GroupBox 10,7,590,84,"",.GroupBox1
Text 20,21,100,14,"Folder:",.Text1
PushButton 500,21,90,21,"Browse...",.Browse
Text 320,56,60,14,"File Ext.",.Text2
TextBox 390,56,100,21,.file_extension
TextBox 120,21,370,21,.folder
DropListBox 120,56,130,28,VBA_Object(),.Format
PushButton 20,182,90,21,"Import Files",.Import
GroupBox 10,105,590,70,"Options (if supported by selected format)",.GroupBox2
CancelButton 120,182,90,21
Text 20,56,90,14,"CAD Format:",.Text3
CheckBox 280,126,230,14,"Scale to current unit",.ScaleToCurrentUnit
CheckBox 30,147,90,14,"Healing",.Healing
CheckBox 30,126,180,14,"Import attributes",.ImportAttributes
End Dialog
Dim dlg As UserDialog
dlg.file_extension = "*.txt"
dlg.ScaleToCurrentUnit = 0
dlg.Healing = 0
dlg.ImportAttributes = 1
Do
dlg.folder = GetProjectPath("Root")
If (Dialog(dlg) = 0) Then Exit All
Loop Until (dlg.folder <> "")
Dim sRootPath As String, n_cadfiles As Integer, sfilename As String, sattr As String
sRootPath = dlg.folder
If dlg.ImportAttributes Then
sattr = "True"
Else
sattr = "False"
End If
datafile_cadfiles = GetProjectPath("Model3D") + "\list_of_cadfiles.dat"
Open datafile_cadfiles For Output As #1
n_cadfiles = 0
sfilename = FindFirstFile(sRootPath, dlg.file_extension, False)
While (sfilename <> "")
Print #1, sRootPath + "\" + sfilename
n_cadfiles = n_cadfiles + 1
sfilename = FindNextFile
Wend
Close #1
Begin Dialog UserDialog 410,105,"List of CAD files",.DialogFunc3 ' %GRID:10,7,1,1
GroupBox 10,7,390,56,"",.GroupBox1
Text 30,21,330,14,"Searching CAD Files Finished:",.Text1
Text 30,42,340,14,"Number of found CAD Files, to be imported = " + CStr(n_cadfiles),.Text2
PushButton 150,77,120,21,"Import Now",.Delete
PushButton 20,77,120,21,"View/Edit List",.View
CancelButton 280,77,100,21
End Dialog
Dim dlg3 As UserDialog
If (Dialog(dlg3) = 0) Then Exit All
Dim sCommand As String, sVbaObj2 As String
sCommand = ""
Select Case dlg.Format
Case TXT
Open datafile For Output As #1
For iData=1 To nData
Read #1, sarray(iData)
Next iData
Close #1
sCommand = sCommand + " .ScaleToUnit """ + CStr(dlg.ScaleToCurrentUnit) + """" + vbLf
End Select
sCommand = sCommand + " .Read" + vbLf
sCommand = sCommand + "End With" + vbLf
AddToHistory "Import multiple " + VBA_Object(dlg.Format) + " Files", sCommand
End Sub
Function DialogFunc%(Item As String, Action As Integer, Value As Integer)
Dim filename As String, Extension As String, Index As Integer
Select Case Action
Case 1 ' Dialog box initialization
Case 2 ' Value changing or button pressed
Select Case Item
Case "Help"
' StartHelp HelpFileName
DialogFunc = True
Case "Browse"
filename = DlgText("folder") + "\" + "Use this directory"
filename = GetFilePath(filename, "", "", "Choose directory, containing CAD files", 2)
If (filename <> "") Then
DlgText "folder", DirName(filename)
End If
DialogFunc = True
Case "Format"
DlgText "file_extension", ext(Value)
DialogFunc = True
End Select
Case 3 ' ComboBox or TextBox Value changed
Case 4 ' Focus changed
Case 5 ' Idle
End Select
End Function
Function DialogFunc3%(Item As String, Action As Integer, Value As Integer)
Dim filename As String, Extension As String, Index As Integer
Select Case Action
Case 1 ' Dialog box initialization
Case 2 ' Value changing or button pressed
Select Case Item
Case "View"
Shell("notepad.exe " + datafile_cadfiles, 1)
DialogFunc3 = True
End Select
Case 3 ' ComboBox or TextBox Value changed
Case 4 ' Focus changed
Case 5 ' Idle
End Select
End Function
