Hallo zusammen,
Ich hab n bissl weiter rumgespielt und hänge nun an dem
Set swmodel = swApp.OpenDoc6(MetalDrawing, swDocDRAWING, swOpenDocOptions_Silent, "", CloseErrors, CloseWarnings) 'öffnet Zeichnung zu Blechteil
Hier kommt immer der Fehler: Laufzeitfehler '91': Objektvariable oder With-Blockvariable nicht festgelegt ... bin da voll überfragt
Ich hab echt vieles Versucht, alle Variablen deklariert (zumindest glaub ich das), bin aber nicht weitergekommen...
Gleicher Fehler kommt, wenn ich nach den ganzen Dim Deklarationen ein 'Set swmodel = swApp.ActivDoc' einsetze ... Dann erscheint der Fehler dort ...
Anbei mein ein wenig optimierter Code ...
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc2
Set swApp = CreateObject("SldWorks.Application")
Set swmodel = swApp.ActiveDoc
Dim savepath As String
savepath = InputBox("Where do you want to save?")
traverse swApp.ActiveDoc, savepath
End Sub
Function traverse(Pathname As ModelDoc2, savepath As String)
Dim swApp As SldWorks.SldWorks
Dim swComp As SldWorks.Component2
Dim swmodel As SldWorks.ModelDoc2
Dim vChildComp As Variant
Dim swChildComp As SldWorks.Component2
Dim sPadStr As String
Dim i As Long
Dim swRootComp As SldWorks.Component2
Dim swConf As SldWorks.Configuration
Dim swConfMgr As SldWorks.ConfigurationManager
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long
Dim longwarnings As Long
Dim assem As String
Dim part1 As String
Dim Foldername As String
Dim PathLength As Variant
Dim Filepath As String
Dim Filename As String
Set swApp = CreateObject("SldWorks.Application")
Set swmodel = Pathname
Set Part = swmodel
Set swConfMgr = swmodel.ConfigurationManager
Set swConf = swConfMgr.ActiveConfiguration
Set swRootComp = swConf.GetRootComponent3(True)
vChildComp = swRootComp.GetChildren
For i = 0 To UBound(vChildComp)
Set swChildComp = vChildComp(i)
Set swmodel = swChildComp.GetModelDoc2
If Not swmodel Is Nothing Then
If swmodel.GetType = 2 Then
traverse swmodel, savepath
Else
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Place what you want to run on each part here this is an example that will save all parts as an stl
flat swmodel, savepath
'Debug.Print swmodel.GetPathName
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End If
End If
Next i
End Function
Public Function GetTitle(Path As String)
Dim path1 As Variant
Dim title As String
path1 = Split(Path, "\")
title = path1(UBound(path1))
GetTitle = Left(title, InStr(title, ".") - 1)
End Function
Sub flat(swmodel As SldWorks.ModelDoc2, savepath As String)
Dim swApp As SldWorks.SldWorks
Set swApp = CreateObject("SldWorks.Application")
'Set swmodel = swApp.ActiveDoc
Dim swfeat As SldWorks.Feature
Set swfeat = swmodel.FirstFeature
Dim swflat As SldWorks.Feature
Dim swsubfeat As SldWorks.Feature
'Do Until UCase(swfeat.Name) = "ORIGIN"
' swfeat = swfeat.GetNextFeature
' Loop
Do While Not swfeat Is Nothing
If swfeat.GetTypeName = "FlatPattern" Then
'MsgBox swfeat.Name & " " & swfeat.GetTypeName
Set swflat = swfeat
swfeat.Select (True)
swmodel.EditUnsuppress2
dxf swmodel, savepath
swflat.Select (True)
swmodel.EditSuppress2
pdf swmodel, savepath
swApp.CloseDoc (swmodel.GetPathName)
End If
Set swfeat = swfeat.GetNextFeature
Loop
' largest
End Sub
Public Function dxf(swmodel As SldWorks.ModelDoc2, savepath As String)
Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.PartDoc
Dim sModelName As String
Dim sPathName As String
Dim varAlignment As Variant
Dim dataAlignment(11) As Double
Dim varViews As Variant
Dim dataViews(1) As String
Dim options As Long
Set swApp = Application.SldWorks
swApp.ActivateDoc swmodel.GetPathName
If swmodel.GetBendState <> 2 Then
Exit Function
End If
sModelName = swmodel.GetPathName
sPathName = swmodel.GetPathName
sPathName = Left(sPathName, Len(sPathName) - 6)
sPathName = sPathName + "dwg"
Set swPart = swmodel
dataAlignment(0) = 0#
dataAlignment(1) = 0#
dataAlignment(2) = 0#
dataAlignment(3) = 1#
dataAlignment(4) = 0#
dataAlignment(5) = 0#
dataAlignment(6) = 0#
dataAlignment(7) = 1#
dataAlignment(8) = 0#
dataAlignment(9) = 0#
dataAlignment(10) = 0#
dataAlignment(11) = 1#
varAlignment = dataAlignment
dataViews(0) = "*Current"
dataViews(1) = "*Front"
varViews = dataViews
'Export each annotation view to a separate drawing file
'swPart.ExportToDWG sPathName, sModelName, 3, False, varAlignment, False, False, 0, varViews
'Export flat pattern of the sheet metal to a single drawing file
options = 33 '0100001 - include flat pattern geometry and "Bibliotheks-Features"
a = swmodel.GetPathName
CText = Split(a, "\")
w = CText(UBound(CText))
w = Left(w, InStr(w, ".") - 1)
Path = savepath & "\Abwicklung-" & swmodel.GetTitle & ".dxf"
Debug.Print Path
swPart.ExportToDWG Path, sModelName, 1, True, varAlignment, False, False, options, Null
Debug.Print "Inspect DWG files in " + Left(sPathName, Len(sPathName) - 16)
End Function
Sub pdf(swmodel As SldWorks.ModelDoc2, savepath As String)
Dim swApp As SldWorks.SldWorks
Dim swDoc As String
Dim pFilepath As String
Dim pFilename As String
Dim MetalDrawing As String
Dim CloseErrors As Long
Dim CloseWarnings As Long
Dim Partpath As String
Dim PartName As String
Dim PDF_Pfad As String
Partpath = Left(swmodel.GetPathName, InStrRev(swmodel.GetPathName, "\"))
PartName = Left(swmodel.GetTitle, Len(swmodel.GetTitle))
MetalDrawing = Partpath & PartName & ".slddrw" ' Pfad der zu öffnenden zeichnung, muss im gleichen Ornder wie Teil sein und selben Namen tragen
'MsgBox (MetalDrawing) ' Kontrolle ob Dateipfad korrekt ... ich weiß, es gibt Debug.Print, dafür bin ich aber noch zu doof
' nachfolgend immer der Fehler: Laufzeitfehler '91': Objektvariable oder With-Blockvariable nicht festgelegt ... bin da voll überfragt
Set swmodel = swApp.OpenDoc6(MetalDrawing, swDocDRAWING, swOpenDocOptions_Silent, "", CloseErrors, CloseWarnings) 'öffnet Zeichnung zu Blechteil
If (swmodel Is Nothing) Or (swmodel.GetType <> swDocDRAWING) Then
Exit Sub ' wenn Zeichnung nicht gefunden oder geöffnet bei nächstem Blech weiter machen
End If
Set swmodel = swApp.ActiveDoc ' Kontrolle ob Zeichnung aktiv
Set swDraw = swmodel
' pFilepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
' pFilename = Left(swDraw.GetTitle, Len(swDraw.GetTitle) - 9) '
' PDF_Pfad = savepath & pFilename & ".pdf" ' Speicherpfad-Name für PDF
PDF_Pfad = savepath & PartName & ".PDF"
' MsgBox (PDF_Pfad) ' Kontrolle ob Pfad korrekt
swDraw.SaveAs (PDF_Pfad) ' PDF speichern
swApp.CloseDoc (MetalDrawing) ' Zeichnung schließen
End Sub
Zum Test eine BG mit min. 1 Blech öffnen und Makro starten, Speicherpfad für DXF einfügen (hier kommen später auch die PDFs hin) und starten ...
Vielen lieben Dank für eure Hilfe ...
Verzweifelt und Ratlos
Carsten
------------------
Chef: Geht das auch etwas schneller?
Ich: Mein Gehaltsvolumen ist aufgebraucht, ich arbeite jetzt mit reduzierter Geschwindigkeit!
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP