Specify IGES Levels and Values, Then Import IGES File Example (VBA)
This example shows how to specify levels and values when importing IGES
data.
'-------------------------------
'
' Preconditions: Specified IGES file exists.
'
' Postconditions: Specified IGES file is imported into
SolidWorks.
'
'--------------------------------
Option Explicit
Private Sub main()
Dim
swApp As Object
Dim
model As SldWorks.ModelDoc2
Dim
boolstatus As Boolean
Dim
fileName As String
Dim
argString As String
Dim
importData As SldWorks.ImportIgesData
Dim
Err as long
Dim
orgSetting As Boolean
Dim
allLevels As Boolean
Dim
vOnlyLev As Variant
Dim
onlyLev(0 To 1) As Long
Dim
oneLev As Long
Dim
lastFeature As SldWorks.Feature
Dim
newFolder As SldWorks.Feature
Dim
newFolderName As String
Dim
lastFeatureName As String
Set
swApp = Application.SldWorks
Set
model = swApp.ActiveDoc
' The file to import into SolidWorks; substitute name
of your IGES file
fileName
= "C:\projects\Misc\IgesImportData\Sw\D54610022.igs"
' "r" means open new document
' "i" means insert into existing document
If
model Is Nothing Then
argString
= "r"
Else
'
there is an existing part, use it
argString
= "i"
End
If
' Fill in the import data, to take the place of the IGES
dialog
Set
importData = swApp.GetImportFileData(fileName)
If
Not importData Is Nothing Then
'
Test the various flags in the levels dialog
importData.IncludeSurfaces = True
importData.IncludeCurves = True
importData.CurvesAsSketches = True '
False = Curves as Curves
importData.ProcessByLevel = False
' Test all levels
' allLevels
= True '
False = levels specified in vOnlyLev VARIANT
' newFolderName
= "All levels"
'
Or, test multiple levels - an array of longs in the VARIANT
' onlyLev(0)
= 0
' onlyLev(1)
= 6
' vOnlyLev
= onlyLev
' newFolderName
= "Layer 0 and 6"
'
Or, test individual levels - a long value in the VARIANT
oneLev
= 25
vOnlyLev
= oneLev
newFolderName
= "Layer " & Format(oneLev)
boolstatus
= importData.SetLevels(allLevels, (vOnlyLev))
End
If
' Keep the last feature, so that you can determine what's
been added.
' If this is a new document, that cannot be done, just
hard code the name of the Origin feature,
' which is currently the last feature in a new part document.
It would probably be
' better to always create a new document first, and then
call SldWorks::LoadFile4
' with "i" argstring to avoid this potential
problem.
If
Not model Is Nothing Then
Set
lastFeature = model.FeatureByPositionReverse(0)
lastFeatureName
= lastFeature.Name
Else
lastFeatureName
= "Origin"
End
If
' Setting this user preference to TRUE means that the
IGES dialog will be displayed.
' Setting this user preference to FALSE means that the
IGES dialog will not be displayed,
' and the import IGES data will be used if it is passed
in, or if it is not,
' the default values for the dialog will be used.
orgSetting
= swApp.GetUserPreferenceToggle(swUserPreferenceToggle_e.swIGESImportShowLevel)
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swIGESImportShowLevel,
False
Set
model = swApp.LoadFile4(fileName,
argString, importData, Err)
' swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swIGESImportShowLevel,
orgSetting
' If the SldWorks::LoadFile4 failed, do not continue.
If
model is Nothing Then
Debug.Print
"Problem loading file. Error message = " & Err
Exit
Sub
End
If
' Retrieve all of the features that were created and move
them into their own new folder.
model.ClearSelection2 True
' Select features that are then used by FeatureManager::InsertFeatureTreeFolder2.
' Either way of selection seems to take the same amount
of time.
' Debug.Print
Now
boolstatus
= select_new_features_individually(model, lastFeatureName)
' boolstatus
= multiselect_new_features(model, lastFeatureName)
' Debug.Print
Now
If
(boolstatus) Then
Set
newFolder = model.FeatureManager.InsertFeatureTreeFolder2(swFeatureTreeFolder_Containing)
If
Not newFolder Is Nothing Then
newFolder.Name = newFolderName
End
If
model.ClearSelection2 True
End
If
End Sub
Private Function select_new_features_individually(model
As SldWorks.ModelDoc2, lastFeatureName As String) As Boolean
Dim
testFeature As SldWorks.Feature
Dim
loopCount As Integer
Dim
boolstatus As Boolean
select_new_features_individually
= False
loopCount
= 0
Set
testFeature = model.FeatureByPositionReverse(loopCount)
While
(Not testFeature Is Nothing) And (Not testFeature.Name
= lastFeatureName)
loopCount
= loopCount + 1
boolstatus
= testFeature.Select2(True, 0)
If
Not boolstatus = 0 Then
select_new_features_individually
= True
End
If
Set
testFeature = model.FeatureByPositionReverse(loopCount)
Wend
End Function
Private Function multiselect_new_features(model As SldWorks.ModelDoc2,
lastFeatureName As String) As Boolean
Dim
testFeature As SldWorks.Feature
Dim
loopCount As Integer
Dim
boolstatus As Boolean
Dim
featureList() As SldWorks.Feature
Dim
vFeatureList As Variant
Dim
longstatus As Long
Dim
selData As SldWorks.SelectData
multiselect_new_features
= False
loopCount
= 0
Set
testFeature = model.FeatureByPositionReverse(loopCount)
While
(Not testFeature Is Nothing) And (Not testFeature.Name
= lastFeatureName)
loopCount
= loopCount + 1
Set
testFeature = model.FeatureByPositionReverse(loopCount)
Wend
ReDim
featureList(0 To loopCount - 1)
loopCount
= 0
Set
testFeature = model.FeatureByPositionReverse(loopCount)
While
(Not testFeature Is Nothing) And (Not testFeature.Name
= lastFeatureName)
Set
featureList(loopCount) = testFeature
loopCount
= loopCount + 1
Set
testFeature = model.FeatureByPositionReverse(loopCount)
Wend
vFeatureList
= featureList
longstatus
= model.Extension.MultiSelect((vFeatureList),
True, selData)
If
longstatus > 0 Then
multiselect_new_features
= True
End
If
End Function