has anyone besides me ever had the problem that the OpenDoc6 method only works in debug mode, or if you force a pause by a message after the command?
As long as you are still programming, you can also insert a breakpoint, then the method will work correctly.
I add the macro and a testfile to the topic. If anybody wants to test copy the stepfile to the c:/temp folder.
Code: Select all
Option Explicit
Sub SelectStepDialog(swApp As SldWorks.SldWorks, StepFileFullName As String)
Dim lfileoptions As Long
Dim fileConfig As String
Dim fileDispName As String
'Show File Dialog to select a Step File
StepFileFullName = swApp.GetOpenFileName("Select Step File", "", "3D-Step Files (*.stp; *.step)|*.stp; *.step|", lfileoptions, fileConfig, fileDispName)
If StepFileFullName = "" Then
swApp.SendMsgToUser2 "No Step File selected!", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
End
End If
End Sub
Sub ImportStepFile(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, StepFileFullName As String)
Dim swImportStepData As SldWorks.ImportStepData
Dim lerrors As Long
'Stepdatei importieren
Set swImportStepData = swApp.GetImportFileData(StepFileFullName)
swImportStepData.MapConfigurationData = True
'Load the STEP file
Set swModel = swApp.LoadFile4(StepFileFullName, "r", swImportStepData, lerrors)
If Not lerrors = "0" Then
swApp.SendMsgToUser2 "Fehler beim Step Importieren!", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
End
End If
End Sub
Sub OpenSLA(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2)
Dim swRootComp As SldWorks.Component2
Dim swComp As SldWorks.Component2
Dim swConf As SldWorks.Configuration
Dim TlaName As String
Dim SlaName As String
Dim CompFullFileName As String
Dim CompName As String
Dim lwarnings As Long
Dim lerrors As Long
'Select Top Level Assembly
Set swModel = swApp.ActiveDoc
Set swConf = swModel.GetActiveConfiguration
Set swRootComp = swConf.GetRootComponent3(True)
TlaName = swRootComp.Name2
'Select Second Level Assembly
Set swComp = swRootComp
Dim vChildComp As Variant
Dim swChildComp As SldWorks.Component2
vChildComp = swComp.GetChildren
Set swChildComp = vChildComp(0)
SlaName = swChildComp.Name2
swChildComp.Select2 False, 0
Debug.Print "TLA: " & TlaName
Debug.Print "SLA: " & SlaName
'Compare Name of TLA and SLA, if equal use SLA
If Left(TlaName, InStr(TlaName, "_") - 1) = Left(SlaName, InStr(TlaName, "_") - 1) Then
CompFullFileName = swChildComp.GetPathName
CompName = Right(swChildComp.GetPathName, CLng(Len(swChildComp.GetPathName)) - CLng(InStrRev(swChildComp.GetPathName, "\")))
Debug.Print "CompFullFileName: " & CompFullFileName
Debug.Print "CompName: " & CompName
Set swModel = swApp.OpenDoc6(CompFullFileName, swDocumentTypes_e.swDocASSEMBLY, swOpenDocOptions_e.swOpenDocOptions_LoadExternalReferencesInMemory, "", lerrors, lwarnings)
Debug.Print "OpenDoc6 errors: " & lerrors
Debug.Print "OpenDoc6 warnings: " & lwarnings
'With this Hack the macro also works well, but i don´t want an additional message
'swApp.SendMsgToUser "Hack"
swApp.ActivateDoc3 CompName, False, swRebuildOnActivation_e.swDontRebuildActiveDoc, lerrors
Debug.Print "ActivateDoc3 errors: " & lerrors
Set swModel = swApp.ActiveDoc
End If
End Sub
Sub main()
Dim swApp As SldWorks.SldWorks
Set swApp = Application.SldWorks
swApp.SetCurrentWorkingDirectory ("C:\temp\")
'Call Sub to Select Step File
Dim StepFileFullName As String
SelectStepDialog swApp, StepFileFullName
'Call Sub to import selected Step File
Dim swModel As SldWorks.ModelDoc2
ImportStepFile swApp, swModel, StepFileFullName
'Call Sub to check if TLA and SLA are equal
Dim CurrCompName As String
OpenSLA swApp, swModel
'Message to show Macro is ready
swApp.SendMsgToUser "Ready"
End Sub