Hot News aus dem CAD.de-Newsletter:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Inventor
  Makro - Baugruppe + Zeichnungen speichern verschiedene Formate

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:   Makro - Baugruppe + Zeichnungen speichern verschiedene Formate (200 mal gelesen)
HADI-AT
Mitglied
Kostruktion


Sehen Sie sich das Profil von HADI-AT an!   Senden Sie eine Private Message an HADI-AT  Schreiben Sie einen Gästebucheintrag für HADI-AT

Beiträge: 81
Registriert: 06.09.2019

SolidWorks 2019 Standard SP3.0
Intel Xeon CPU E5-1630v4 3,7GHz
32 RAM
WIN 10 64 bit

erstellt am: 13. Feb. 2020 11:46    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo zusammen,

ich suche vergeblich nach einen oder zwei Makros für folgenden Aufgaben:
Baugruppe mit Einzelteilen als STEP speichern
alle Zeichnungen öffnen und als .dxf und .pdf speichern

Ich habe folgende Makros gefunden:

Eins zum dxf erzeugen, bzw. das gleiche für pdf bei ausgetauschter Variable

Public Sub CreateDXF()
    On Error Resume Next
    If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then
        Exit Sub
    End If
 
    Dim oDoc As Inventor.DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    If oDoc.FullFileName = "" Then
        MsgBox "Bitte zuerst die Zeichnung speichern...  "
        Exit Sub
    End If
    oDoc.SaveAs Replace(oDoc.FullFileName, Right(oDoc.FullFileName, 3), "dxf"), True
 
    If Err.Number = 0 Then
        MsgBox "Die Datei:" & vbCrLf & vbCrLf & Replace(oDoc.FullFileName, Right(oDoc.FullFileName, 3), "dxf") & vbCrLf & vbCrLf & "wurde erfolgreich gespeichert"
    Else
        MsgBox "Fehler: " & Err.Description
    End If
End Sub

Eins zum Öffnen und schließen der Zeichnungen
mit einem anderen eingebunden Makro aus dem Beitrag
https://ww3.cad.de/foren/ubb/Forum258/HTML/001375.shtml

Code:Public Function InUnterVerzSuchen(VerzPfad As String, DateiTyp As String, Attrib As Integer)
    Dim VerzName As String, DateiName As String, VerzListe() As String, DateiNr As Integer
    Dim VerzNr As Integer, DateiListe() As String, TempListe, Nr As Integer
 
    ' Liste mit Dateinamen erstellen
  If Right$(VerzPfad, 1) = "\" Then
      DateiName = Dir$(VerzPfad & DateiTyp, Attrib)
      'MsgBox DateiName
   
  Else
      DateiName = Dir$(VerzPfad & "\" & DateiTyp, Attrib)
    ' MsgBox DateiName
   
  End If
    DateiNr = 0
 
    While DateiName <> vbNullString
        If (DateiName <> ".") And (DateiName <> "..") Then
            DateiNr = DateiNr + 1
            ReDim Preserve DateiListe(1 To DateiNr)
            DateiListe(DateiNr) = VerzPfad & "\" & DateiName
        End If
        DateiName = Dir$()
    Wend
 
    ' Liste mit Unterverzeichnissen erstellen
    VerzNr = 0
    VerzName = Dir(VerzPfad & "\", Attrib Or vbDirectory)
 
    While VerzName <> vbNullString
        If (VerzName <> ".") And(VerzName <> "..") And VerzName <> "Ungültig" And Left(VerzName, 3) <> "Old" Then
           

    If Right(VerzName, 4) = ".idw" Then
     
        ThisApplication.Documents.Open (VerzPfad & "\" & VerzName)
     
                    Dim Rev As String
                    Dim Bauteil As String
                 
                    Dim oDrawDoc As DrawingDocument
                    Set oDrawDoc = ThisApplication.ActiveDocument
                 
                    'Get the PropertySets
                    Dim oPropertySets As PropertySets
                    Set oPropertySets = oDrawDoc.PropertySets
                 
                    Dim oPropertySet As PropertySet
                    Set oPropertySet = oDrawDoc.PropertySets.Item("Inventor Summary Information")
                 
                    'Get the Property
                    Dim oProperty As Property
                 
                    On Error Resume Next
                 
                    'Revisionsnummer von dem Erstansicht
                    Dim oReferencedPartDoc As Document
                    Set oReferencedPartDoc = oDrawDoc.ReferencedDocuments.Item(1)
                 
                    Set oDrawDoc = ThisApplication.ActiveDocument
                 
                    ' Create the new title block defintion.
                    Dim oTitleBlockDef As TitleBlockDefinition
                    Set oTitleBlockDef = oDrawDoc.ActiveSheet.TitleBlock.Definition
                 
                    Dim a As String
                    Dim b As String
                 
                    Dim oSketch As DrawingSketch
                 
                    Call oTitleBlockDef.Edit(oSketch)
                    a = oSketch.TextBoxes.Item(22).Text
                 
                    Dim oPropValue As String
                    oPropValue = oReferencedPartDoc.PropertySets.Item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}").Item("Part Number").Value
                 
                    If Len(oPropValue) < 10 Then
                 
                    oSketch.TextBoxes.Item(22).FormattedText = "<StyleOverride FontSize='0,6'><Property Document='model' PropertySet='Design Tracking Properties' Property='Part Number' FormatID='{32853F0F-3444-11D1-9E93-0060B03C1CA6}' PropertyID='5'>BAUTEILNUMMER</Property></StyleOverride><StyleOverride FontSize='0,6'> Rev </StyleOverride><StyleOverride FontSize='0,6'><Property Document='model' PropertySet='Inventor Summary Information' Property='Revision Number' FormatID='{F29F85E0-4FF9-1068-AB91-08002B27B3D9}' PropertyID='9'>REVISIONSNUMMER</Property></StyleOverride>"
                    Else:
                 
                    oSketch.TextBoxes.Item(22).FormattedText = "<StyleOverride FontSize='0,4'><Property Document='model' PropertySet='Design Tracking Properties' Property='Part Number' FormatID='{32853F0F-3444-11D1-9E93-0060B03C1CA6}' PropertyID='5'>BAUTEILNUMMER</Property></StyleOverride><StyleOverride FontSize='0,4'> Rev </StyleOverride><StyleOverride FontSize='0,4'><Property Document='model' PropertySet='Inventor Summary Information' Property='Revision Number' FormatID='{F29F85E0-4FF9-1068-AB91-08002B27B3D9}' PropertyID='9'>REVISIONSNUMMER</Property></StyleOverride>"
                    End If
                 
                    Call oTitleBlockDef.ExitEdit
                 
                    Call PDFGenerator_A
                 
                    oDrawDoc.Save2
                    oDrawDoc.Close
             
     
            ' Handelt es sich um ein Verzeichnis ?
            ElseIf GetAttr(VerzPfad & "\" & VerzName) And vbDirectory Then
                VerzNr = VerzNr + 1
                ReDim Preserve VerzListe(1 To VerzNr)
                VerzListe(VerzNr) = VerzName
            'End If
            End If
        End If
        VerzName = Dir$() ' Nächsten Datei- oder Verzeichnisnamen holen
  Wend
 
    ' Rekursiver Aufruf, um Unterverzeichnisse zu durchsuchen
    For VerzNr = 1 To VerzNr
        TempListe = InUnterVerzSuchen(VerzPfad & "\" & VerzListe(VerzNr), DateiTyp, Attrib)
        If IsArray(TempListe) Then
            For Nr = LBound(TempListe) To UBound(TempListe)
                DateiNr = DateiNr + 1
                ReDim Preserve DateiListe(1 To DateiNr)
                DateiListe(DateiNr) = TempListe(Nr)
            Next Nr
        End If
    Next VerzNr
    If DateiNr = 0 Then InUnterVerzSuchen = False Else InUnterVerzSuchen = DateiListe()
End Function

Sub test()

Call InUnterVerzSuchen("I:\Kunden", ".idw", vbDirectory)
MsgBox "Fertig!"


End Sub

Ich könnte mir vorstellen, dass man die Makros evtl kombinieren könnte, aber dazu habe ich zu wenig programmiertechnische Erfahrung. Kann da vielleicht einer der Programmierspezialisten weiterfelen?

Das i Tüpfelchen wäre dann das speichern als STEP, aber ich denke das wäre das geringste Übel wenn es nicht klappt. Wenn die dxf und pdf erstellt werden können, würde das schon Stunden an Arbeit sparen.

Gruß,
Hadi

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

KraBBy
Mitglied
Maschinenbau-Ingenieur


Sehen Sie sich das Profil von KraBBy an!   Senden Sie eine Private Message an KraBBy  Schreiben Sie einen Gästebucheintrag für KraBBy

Beiträge: 280
Registriert: 19.09.2007

Inventor Professional 2016
Win7

erstellt am: 13. Feb. 2020 12:41    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für HADI-AT 10 Unities + Antwort hilfreich

Wenn das mit den Zeichnungen für alle idw in einem Verzeichnis passieren soll, wäre es nicht was für die "Aufgabenplanung"?
Bin kein Experte dafür, aber in einem Pfad (mit Unterverz.) nach idw suchen und diese dann als dxf abspeichern, das klappt. Pdf vmtl. auch.

------------------
Gruß KraBBy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

HADI-AT
Mitglied
Kostruktion


Sehen Sie sich das Profil von HADI-AT an!   Senden Sie eine Private Message an HADI-AT  Schreiben Sie einen Gästebucheintrag für HADI-AT

Beiträge: 81
Registriert: 06.09.2019

SolidWorks 2019 Standard SP3.0
Intel Xeon CPU E5-1630v4 3,7GHz
32 RAM
WIN 10 64 bit

erstellt am: 17. Feb. 2020 10:51    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Wir haben es gerade mit dxf getestet. Das klappt sehr gut, danke! Hätte nicht gedacht, dass das doch so einfach geht.

Das mit dem .pdf erstellen wäre noch interessant. Das geht scheinbar nicht auf direktem Weg wie die .dxf Dateien.
Kennt sich da wer aus?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2020 CAD.de | Impressum | Datenschutz