Ik heb de macro hieronder die wel of niet werkt, afhankelijk van welke regel ik gebruik (filepath).
Voor het bestandspad dat naar Z:\1 Plans 2021\MONTIFAUD SAS CHATEAU is gericht, werkt het heel goed, het opent de schroefvijl, steekt de schroef in mijn montageplan en sluit de schroefvijl (Nikkel).
Terwijl het andere bestandspad dat naar Z:\SolidWorks\Library wordt geleid, niet gebeurt.
Ik zit op dezelfde server, ik gebruik dezelfde PRT, alleen het pad is anders
Heb je een verklaring voor mij?
Is er een fout in de macro bij de declaratie van variabelen?
Het doel van deze macro is om deze later in Userform te integreren.
Bij voorbaat dank.
Vriendelijke groeten.
MACRO
Dim swPart As SldWorks.ModelDoc2 Dim boolstatus als Booleaanse Dim longstatus As Long, longwarnings As Long Dim filePath als tekenreeks Dim swApp als object Deel dimmen als object Sub hoofd() Stel swApp = Toepassing.SldWorks in Stel swPart in = swApp.ActiveDoc Dim tmpObj als ModelDoc2 Dim fouten zo lang mogelijk filePath = "Z:\SolidWorks\Bibliotheek\Schroeven\Roestvrijstalen schroeven-TH.SLDPRT" 'filePath = "Z:\1 Plannen 2021\MONTIFAUD SAS CHATEAU\3D-model\Schroeven\Roestvrij staal-Schroeven-TH.SLDPRT" Stel tmpObj = swApp.OpenDoc6(filePath, 1, 32, "", fouten, lange waarschuwingen) in Deel instellen = swApp.ActivateDoc3(filePath, True, 0, fouten) Dim swInsertedComponent als component2 Stel swInsertedComponent = swPart.AddComponent5(filePath, 0, "", False, "", 0, 0, 0) in swApp.CloseDoc filePath Einde Sub
Hallo Natuurlijk vervang je de waarde in je variabele! Probeer het volgende:
Sub Insert
Dim swPart As SldWorks.ModelDoc2
Dim boolstatus As Boolean
Dim longstatus As Long, errors, longwarnings As Long
Dim FilePath1, FilePath2 As String
Dim swApp As Object
Dim Part As Object
Dim tmpObj As ModelDoc2
Sub main()
Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
FilePath1 = "Z:\SolidWorks\Bibliotheque\Visserie\Vis-Inox-TH.SLDPRT"
FilePath2 = "Z:\1 Plans 2021\MONTIFAUD SAS CHATEAU\Modele 3D\Visserie\Vis-Inox-TH.SLDPRT"
Set tmpObj = swApp.OpenDoc6(FilePath1, 1, 32, "", errors, longwarnings)
Set Part = swApp.ActivateDoc3(FilePath1, True, 0, errors)
Dim swInsertedComponent As Component2
Set swInsertedComponent = swPart.AddComponent5(FilePath2, 0, "", False, "", 0, 0, 0)
swApp.CloseDoc FilePath1
End Sub
Ik heb het geprobeerd, maar ik heb een type 13 uitvoeringsfout met type incompatibiliteit.
Stel swInsertedComponent in = swPart.AddComponent5(In te voegen in huidige assemblage//, 0, "", False, "", 0, 0, 0)
Op de bovenstaande regel wil ik het onderdeel in de huidige assemblage kunnen plaatsen dat niet belangrijk is of dat zich op de server of lokaal bevindt.
Ik noem mijn deel in "Z:\SolidWorks\Library\Screws\Stainless Steel-Screws-TH.SLDPRT" --> die ik in een gemeenschappelijke assemblage invoeg.
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.ModelDoc2
Dim tmpObj As SldWorks.ModelDoc2
Dim errors As Long
Dim longwarnings As Long
Dim FilePath1 As String
Dim FilePath2 As String
Sub main()
Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
FilePath1 = swPart.GetPathName
FilePath2 = "Z:\SolidWorks\Bibliotheque\Visserie\Vis-Inox-TH.SLDPRT"
Set tmpObj = swApp.OpenDoc6(FilePath2, 1, 32, "", errors, longwarnings)
Set swPart = swApp.ActivateDoc3(FilePath1, True, 0, errors)
Dim swInsertedComponent As Component2
Set swInsertedComponent = swPart.AddComponent5(FilePath2, 0, "", False, "", 0, 0, 0)
swApp.CloseDoc FilePath2
End Sub
Sterker nog, we moeten alles herzien! Het is absoluut noodzakelijk dat het geopende bestand een assemblage is.
Probeer dit door het pad van een assembly toe te voegen:
Dim swApp As Object
Dim swModel As ModelDoc2
Dim swAssy As AssemblyDoc
Dim swcomponent As SldWorks.Component2
Dim errors, warnings As Long
Dim FilePath1, FilePath2, FileName, AssemblyTitle As String
Sub Main
Set swApp = Application.SldWorks
FilePathASM = "Chemin de ton assemblage"
FilePathPart = "Z:\SolidWorks\Bibliotheque\Visserie\Vis-Inox-TH.SLDPRT"
FileName = "Vis-Inox-TH.SLDPRT"
Set swModel = swApp.OpenDoc6(FilePathASM, swDocumentTypes_e.swDocASSEMBLY, swOpenDocOptions_e.swOpenDocOptions_Silent, "", errors, warnings)
AssemblyTitle = swModel.GetTitle
Set tmpObj = swApp.OpenDoc6(FilePathPart, swDocPART, 0, "", errors, warnings)
If warnings = swFileLoadWarning_ReadOnly Then
MsgBox "This file is read-only."
End If
If tmpObj Is Nothing Then
MsgBox "Cannot locate the file."
End If
Set swModel = swApp.ActivateDoc3(AssemblyTitle, True, swUserDecision, errors)
Set swAssy = swModel
Set swcomponent = swAssy.AddComponent5(FileName, swAddComponentConfigOptions_CurrentSelectedConfig, "", False, "", -1, -1, -1)
End Sub
Wees echter voorzichtig, mijn macro kan niet omgaan met mogelijke fouten, dus je moet nadenken over het toevoegen van deze beroemde foutafhandeling die vaak wordt verwaarloosd ... Naar mijn mening zijn er ten minste 4 controles die moeten worden uitgevoerd: 1°) na de regel "Set swApp = Application.SldWorks" moet je ervoor zorgen dat een document open is in SW en dat dit document inderdaad een assembly is. 2°) na de regel "Set swPart = swApp.ActiveDoc" moet je ervoor zorgen dat de assembly die in SW is geopend geen nieuwe niet-geregistreerde assembly is. 3°) na de regel "Set swPart = swApp.ActiveDoc" moet je ervoor zorgen dat de in SW geopende assemblage niet alleen-lezen is. 4°) na de regel "FilePath2 = "Z:\SolidWorks\Library\Screws\Screws-Inox-TH.SLDPRT"" moet je ervoor zorgen dat dit bestand bestaat.
Om uw eerste vragen te beantwoorden: - Hebben jullie een verklaring voor mij? Ja, u heeft het object "Part" geactiveerd met de functie "ActivateDoc3", maar u heeft geprobeerd de component toe te voegen in het object "swPart" met de functie "AddComponent5".
- Zit er een fout in de macro bij de declaratie van variabelen? er is een gebrek aan homogeniteit in de declaratie van variabelen zoals "SldWorks.ModelDoc2" of "ModelDoc2" of "Object" voor variabelen van hetzelfde type (swPart, Part en tmpObj).
Dit zijn fouten die ik vrij vaak zie omdat de VBA vrij flexibel is in het typen van variabelen en ook vanwege het kopiëren van codefragmenten die van rechts en links worden opgehaald.
