Hot News aus dem CAD.de-Newsletter:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  SolidWorks
  Makro - Solidworks 2018/2019

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 - Solidworks 2018/2019 (1713 mal gelesen)
Rene82
Mitglied



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

Beiträge: 11
Registriert: 14.05.2019

erstellt am: 14. Mai. 2019 10:56    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 hoffe ihr könnt mir bei der Erstellung eines Makros helfen!
Folgende Funktionalität:

Es geht darum das Zeichnungen, egal ob jetzt eine oder mehrere in Solidworks geöffnet sind, per Makro als PDF-Datei an einer definierten Stelle( Pfad) abgelegt werden, dabei aber der Dateinamen sich aus bestimmten benutzerdefinierten Eigenschaften zusammen setzen soll: Beispiel: "Zeichnungsnummer" + "Revision" + _"Benennung" + ".pdf"

Den normalen Export als PDF habe ich hinbekommen mit Hilfe des WWW´s.

Hier mein bisheriger "Code":

Sub main()
Dim swApp          As SldWorks.SldWorks
Dim swModel        As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim SWmoddoc        As SldWorks.ModelDoc2
Dim strFilename    As String
Dim swConfigMgr    As SldWorks.ConfigurationManager
Dim swConfig        As SldWorks.Configuration
Dim swCustPropMgr  As SldWorks.CustomPropertyManager
Dim pfad            As String
    pfad = "W:\400_ABCD\410_EFGH\IJKL\200_MNOP\510_QRST\010_UVWX\002_YZ99\"

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swConfigMgr = swModel.ConfigurationManager
Set swConfig = swConfigMgr.ActiveConfiguration
Set swCustPropMgr = swConfig.CustomPropertyManager

'Save
swModel.Save3 0, 0, 0

'Export to PDF if it is a drawing
If swModel.GetType = swDocDRAWING Then
    strFilename = swModel.GetPathName
    strFilename = Left(strFilename, Len(strFilename) - 7) & ".pdf"
    strFilename = pfad & Mid$(strFilename, InStrRev(strFilename, "\") + 1)
    'strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
    Set swExportPDFData = swApp.GetExportFileData(1)
    swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
    MsgBox (strFilename)
End If

End Sub


Über eure Hilfe bin ich sehr dankbar!
Sollte dieser Eintrag an der falschen Stelle des Forums sein, bitte verschiebt diesen in den richtigen Bereich!

Gruß René

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

HenryV
Mitglied
Konstrukteur, Engineering


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

Beiträge: 698
Registriert: 18.05.2005

SolidWorks 2018 x64 SP4.0
Dell T3600 Workstation
Intel XENON 6x3.2 GHz
NVIDIA Quadro 4000 2 GB
16GB RAM
2x Dell U2412M, 24" TFT
Windows 7 Professional x64 SP1
Microsoft Office Pro 2010 SP2
Kaspersky Anti-Virus 10.2.4.674
Microsoft VB 2010 Express
SpacePilot von 3Dconnexion

erstellt am: 15. Mai. 2019 12:04    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 Rene82 10 Unities + Antwort hilfreich

ConZept
Mitglied
Maschinenbautechniker


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

Beiträge: 15
Registriert: 19.02.2019

SolidWorks 2018 / SP 4.0
Win7x64 /HP Z440

erstellt am: 15. Mai. 2019 20:26    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 Rene82 10 Unities + Antwort hilfreich

Hallo René!

Finde ich gut, dass du dir schon ein wenig Code selbst zusammengeschnipselt hast.

Vorab ein kleiner Tipp, wenn du dich des öfteren mit Makros beschäftigen möchtest:

Code-Lesbarkeit:
Ich persönlich bevorzuge es die einzelnen Teile des strings zu bekommen, um diese im Anschluss in einen string zu vereinen.
Wenn du auch ein vorgegebenen string hast (in deinem Beispiel der Speicherpfad), würde ich das schon in der Deklaration mit angeben.

Code:
Const sPath as string = "W:\400_ABCD\410_EFGH\IJKL\200_MNOP\510_QRST\010_UVWX\002_YZ99\"

Manchmal kann es auch einfacher sein, den Titel des Dokuments zu holen, anstatt den Speicherpfad zu zerstückeln (je nach Arbeitsweise).

Code:

Dim swApp as SldWorks.SldWorks
Dim swModel as ModelDoc2
Dim sTitle as string

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

sTitle = swModel.GetTitle


Wenn du weißt, dass das Makro nur in Zeichnungen verwendbar ist, dann würde ich deinen "Check" nach einer offenen Zeichnung ganz an den Anfang stellen.

Code:

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

If swModel.GetType <> swDocDRAWING Then
   End 'Beendet das Makro
End if

'Und weiter geht's mit dem Code..



So aber nun zu deiner Frage ;p

Um an die Benutzerdefinierten Eigenschaften zu kommen, musst du den CustomPropertyManager verwenden, den du auch schon deklariert hast.

Code:

Dim IRet as Integer
Dim ValOut as String
Dim ResolvedValOut as String
Dim sProperty as String 'Deine Eigenschaft, wie z.B. Revision
Dim WasResolved as Boolean

Dim swApp as SldWorks.SldWorks
Dim swModel as ModelDoc2
Dim swCustPropMgr as SldWorks.CustomPropertyManager
Dim swModelExt as SldWorks.ModelDocExtension

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelExt = swModel.Extension
Set swCustPropMgr = swModelExt.CustomPropertyManager("")

IRet = swCustPropMgr.Get5("Name der Eigenschaft für bspw. Revision", False, ValOut, ResolvedValOut, WasResolved)
'IRet = 1 wenn es die Eigenschaft nicht gibt / IRet = 2 wenn die Eigenschaft existiert
sProperty = ValOut 'ValOut gibt den Wert der Benutzerdefinierten Eigenschaft zurück


Das Ganze geht natürlich auch, wenn du Konfigurationsspezifische Eigenschaften haben möchtest, hier darfst du aber erst mal selbst ausprobieren ;-)
So kannst du dir dann deine benötigten Eigenschaften holen (Revision, Benennungen etc..) und dir das als Speichernamen zusammenstellen.

Hoffe das bringt dich etwas weiter 

------------------
Gruß ConZept

[Diese Nachricht wurde von ConZept am 15. Mai. 2019 editiert.]

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

Rene82
Mitglied



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

Beiträge: 11
Registriert: 14.05.2019

erstellt am: 16. Mai. 2019 16:01    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 ConZept,
Hallo Andreas,

vielen lieben Dank für eure Unterstützung! DANKE!

Ich habe es dank deiner deiner Unterstützung mit deinem "Code" geschafft, ConZept, das er die Werte aus den Benutzerdefinierten Eigenschaften ausliest, aber bin ich noch auf etwas anderes gestoßen:

Die benutzerdefinierten Eigenschaften sind im 3D-Model hinterlegt (erstellt mit dem Proberty Tab Builder und Properties.txt, template.asmprp; template.prtprp ) und werden automatisch in das Schriftfeld der Zeichnung eingetragen.

Dies bedeutet das die Zeichnung an sich keine benutzerdefinierten Eigenschaften besitzt. Ich habe mir die Mühe gemacht gehabt und der "TestZeichnung" benutzerdefinierte Eigenschaften (template.drwprp) zugewiesen, damit ich die ValOut-Werte bekomme. Diese Werte allerdings in den "Speichernamen" zu werfen, gelingt mir leider nicht, da bin ich einfach ein "little stupid Newbie".

Solidworks benötigt für Baugruppe; Einzelteil; Zeichnung immer ein extra template. Ich habe auch noch keine Möglichkeit gefunden das Solidworks automatisch die benutzerderfinierten Eigenschaften aus dem 3D-Model (template.asmprp --> template.dreprp) in die benutzerdefinierten Eigenschaften der Zeichnung übertrag ausser in das Schriftfeld per Verlinkung "$PRPSheet{}". Die Vorlagen (Templates) sind alle vom Inhalt her gleich aufgebaut und benannt.


Also kommt somit die Herausforderung hinzu:

Die benutzerdefinierten Eigenschaften aus dem 3D-Model zu nutzen, welche automatisch in das Zeichnungsschriftfeld (Verknüpfung per $PRPSheet{}) eingetragen werden und für das Abspeichern der Zeichnung im PDF-Format mit dem genannten Aufbau genutzt werden (ZnNr+Rev_Bez.pdf)


Hier mein Stand:

Sub main()

Set swApp = Application.SldWorks
Dim swModel As ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim SWmoddoc        As SldWorks.ModelDoc2
Dim strFilename    As String
Dim swConfigMgr    As SldWorks.ConfigurationManager
Dim swConfig        As SldWorks.Configuration
Dim swCustPropMgr  As SldWorks.CustomPropertyManager
Dim sTitle As String
Const sPath As String = "W:\400_Name1\410_Name2\Name3\Exportdaten\010_Name4\"

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

sTitle = swModel.GetTitle

If swModel.GetType <> swDocDRAWING Then
  End 'Beendet das Makro
End If

Dim IRet As Integer
Dim IRet2 As Integer
Dim IRet3 As Integer
Dim ValOut As String
Dim ValOut2 As String
Dim ValOut3 As String
Dim sProperty As String 'Deine Eigenschaft, hier Zeichnungsnummer
Dim sProperty2 As String 'Deine Eigenschaft, hier Revision
Dim sProperty3 As String 'Deine Eigenschaft, hier Bezeichnung
'Dim Zeichnungsnummer As String
'Dim Revision As String
'Dim Beschreibung As String
Dim ResolvedValOut As String
Dim ResolvedValOut2 As String
Dim ResolvedValOut3 As String
Dim WasResolved As Boolean
Dim WasResolved2 As Boolean
Dim WasResolved3 As Boolean
Dim swModelExt As SldWorks.ModelDocExtension

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelExt = swModel.Extension
Set swCustPropMgr = swModelExt.CustomPropertyManager("")

IRet = swCustPropMgr.Get5("Zeichnungsnummer", False, ValOut, ResolvedValOut, WasResolved)
'IRet = 1 wenn es die Eigenschaft nicht gibt / IRet = 2 wenn die Eigenschaft existiert
IRet2 = swCustPropMgr.Get5("Revision", False, ValOut2, ResolvedValOut2, WasResolved2)
IRet3 = swCustPropMgr.Get5("Beschreibung", False, ValOut3, ResolvedValOut3, WasResolved3)
sProperty = ValOut = "Zeichnungsnummer"  'ValOut gibt den Wert der Benutzerdefinierten Eigenschaft zurück
sProperty2 = ValOut2 = "Revision"  'ValOut gibt den Wert der Benutzerdefinierten Eigenschaft zurück
sProperty3 = ValOut3 = "Beschreibung"  'ValOut gibt den Wert der Benutzerdefinierten Eigenschaft zurück

'Export to PDF if it is a drawing
If swModel.GetType = swDocDRAWING Then
    strFilename = "_" & ".pdf"
    Set swExportPDFData = swApp.GetExportFileData(1)
    swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
    MsgBox (sPath + strFilename)
   
End If

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

ConZept
Mitglied
Maschinenbautechniker


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

Beiträge: 15
Registriert: 19.02.2019

SolidWorks 2018 / SP 4.0
Win7x64 /HP Z440

erstellt am: 16. Mai. 2019 20:14    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 Rene82 10 Unities + Antwort hilfreich

Hallo René,

schön das du weiter gekommen bist 
Das ist meist normal, dass man immer auf weitere Hürden stößt, die es zu überwinden gilt.

Du kannst aber auch aus der Zeichnung heraus auf die Eigenschaften des referenzierten Teils/Baugruppe zugreifen. Stichwort hier: ReferencedDocument
Damit kannst du aus einer View das ModelDoc2 des referenzierten Dokuments bekommen und weiter bearbeiten.
Würde dann quasi so aussehen:

Code:

Dim swApp as SldWorks.SldWorks
Dim swModel as ModelDoc2
Dim swDraw as SldWorks.DrawingDoc
Dim swView as SldWorks.View

Set swApp = Application.SldWorks
Set swDraw = swApp.ActiveDoc
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView 'erste Ansicht auf der Zeichnung

Set swModel = swView.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil



Dann geht es "normal" weiter um die Eigenschaften auszulesen.

Habe auch deinen Code ein wenig "verschönert", wie ich ihn schreiben würde. Einfach um hochgezählte Variablen zu vermeiden:

Code:

Dim swApp as SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swModelExt As SldWorks.ModelDocExtension
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim swExportPDFData As SldWorks.ExportPdfData

Dim IRet As Integer

Dim strFilename As String
Dim sTitle As String
Dim ValOut As String
Dim sDrawingNo As String 'Zeichnungsnummer
Dim sRevision As String 'Revision
Dim sDescription As String 'Bezeichnung
Dim ResolvedValOut As String

Dim WasResolved As Boolean

Const sPath As String = "W:\400_Name1\410_Name2\Name3\Exportdaten\010_Name4\"

'********************** Properties *****************************
Const pZeichnungsnummer As String = "Zeichnungsnummer"
Const pRevision As String = "Revision"
Const pBeschreibung As String = "Beschreibung"
'***************************************************************
Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

If swModel.GetType <> swDocDRAWING Then
MsgBox "Makro kann nur in Zeichnungen ausgeführt werden.", vbCritical
End 'Beendet das Makro
End If

sTitle = swModel.GetTitle

Set swModelExt = swModel.Extension
Set swCustPropMgr = swModelExt.CustomPropertyManager("")

'Hole die Zeichnungsnummer
IRet = swCustPropMgr.Get5(pZeichnungsnummer, False, ValOut, ResolvedValOut, WasResolved)
sDrawingNo = ValOut

'Hole die Revision
IRet = swCustPropMgr.Get5(pRevision, False, ValOut, ResolvedValOut2, WasResolved2)
sRevision = ValOut

'Hole die Beschreibung
IRet = swCustPropMgr.Get5(pBeschreibung, False, ValOut, ResolvedValOut3, WasResolved3)
sDescription = ValOut

'Export to PDF if it is a drawing
'Hier brauchst du kein check mehr nach der Zeichnung, da dies schon am Anfang steht

strFilename = sPath & sDrawingNo & "+" & sRevision & "_" & sDescription & ".pdf"
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
MsgBox (sPath + strFilename)


Habe gerade kein VBA zur Verfügung, um zu sehen ob das funktioniert, aber ich hoffe du kriegst die Idee ;-)
Viel Erfolg beim ausprobieren mit dem referenzierten Dokument!

------------------
Gruß ConZept

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

Rene82
Mitglied



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

Beiträge: 11
Registriert: 14.05.2019

erstellt am: 21. Mai. 2019 09:29    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 Conzept,

ich bin sehr froh und dankbar für deine Unterstützung!

Habe jetzt die letzten Tage versucht die Eigenschaften aus dem Model, welches ja mit bzw. in der Zeichnung referenziert ist auslesen:

das war dein Tip: Set swModel = swView.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil

Er nimmt bzw. liest es aber nicht aus:
'Hole die Zeichnungsnummer
IRet = swCustPropMgr.Get5(pZeichnungsnummer, False, ValOut, ResolvedValOut, WasResolved)
sDrawingNo = ValOut

Sobald ich allerdings die benutzerdefinierten Eigenschaften über das Template.drwprp per Hand eintrage und dann das Makro laufen lasse, nimmt er aus den Zellen (Zn., Rev., Bez.)die händig eingetragenen Werte. Aber eine Referenzierung zum Model macht er irgendwie nicht. Obwohl er mir hier : "sTitle = swModel.GetTitle das Model" richtig ausgibt. Unter "Set swModel = swView.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil" gibt er mir NOTHING zurück.

   

Gruß René

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

Spirou85
Mitglied
Konstruktuer und CAD-Betreuer


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

Beiträge: 62
Registriert: 01.12.2014

HP ZBook 17 G3
i7-6820 2,7 GHz - 32GB Ram
NVIDIA Quadro M4000M
Windows 10 Pro 64Bit Version 1803
Build 17134.285
SWX2018-64Bit-SP5.0
MaxxDB 2018 SP0.56
DraftSight 2018 x64 SP2
3DCONNEXION SpaceMouse Enterprise mit CadMouse

erstellt am: 21. Mai. 2019 10:22    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 Rene82 10 Unities + Antwort hilfreich

Hallo René,

mit dem Code von Conzept holst Du Die schon die zweite Ansicht, und wenn Du nur eine Ansicht in der Zeichnung hast, dann wird natürlich Nothing zurück gegeben.

Statt

Code:

Dim swApp as SldWorks.SldWorks
Dim swModel as ModelDoc2
Dim swDraw as SldWorks.DrawingDoc
Dim swView as SldWorks.View

Set swApp = Application.SldWorks
Set swDraw = swApp.ActiveDoc
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView 'erste Ansicht auf der Zeichnung

Set swModel = swView.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil


müsste es folgendermaßen lauten:

Code:

Dim swApp as SldWorks.SldWorks
Dim swModel as ModelDoc2
Dim swDraw as SldWorks.DrawingDoc
Dim swView as SldWorks.View

Set swApp = Application.SldWorks
Set swDraw = swApp.ActiveDoc
Set swView = swDraw.GetFirstView  'erste Ansicht auf der Zeichnung

Set swModel = swView.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil


Dann hat man einen Pointer auf die erste Ansicht.

------------------
Viele Grüße aus Brackenheim

Lars Pauly

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

Rene82
Mitglied



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

Beiträge: 11
Registriert: 14.05.2019

erstellt am: 21. Mai. 2019 12:17    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


Umschalten.PNG

 
Hallo Lars,
Hallo ConZept,

danke für den Hinweis mit "getfirstview"!

Aber leider nimmt er nicht das referenzierte Model innerhalb der Zeichnung um die Werte auszulesen!

Ich denke das Problem in Bezug auf folgendes ist: Es muss ein Makrobefehl geben der der Zeichnung sagt: "Nimm nicht die Eigenschaften der aktuellen Zeichnung sondern nimm die im Model gefundenen Eigenschaften. Dieses Umschalten von "Benutzereigenschaften verwenden von "Aktuelles Dokument" auf "Modell hier gefunden" --> danach Name der Eigenschaft wählen --> Zeichnungsnummer (<-- siehe beigefügten Screenshot). Über diesen Weg habe ich ja das Schriftfeld "automatisiert". Der Anwender muss somit nur einmal im Model die Benutzerdefinierten Eigenschaften eintragen und nicht mehrmals die selbe "Arbeit" machen, vermindern ja auch die Fehlerrate.

Und dieses Umschalten auf "Modeleigenschaften" ist der Knackpunkt, denke ich.

Wie schon erwähnt, sobald ich die Eigenschaften per Hand in das template.drwprp eintrage, läuft das Makro auch. Das Makro bezieht sich leider aus irgendeinem Grund nur auf die Eigenschaften des aktuellen "Zeichnungs-"Dokumentes.

     

Grüße René

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

Spirou85
Mitglied
Konstruktuer und CAD-Betreuer


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

Beiträge: 62
Registriert: 01.12.2014

HP ZBook 17 G3
i7-6820 2,7 GHz - 32GB Ram
NVIDIA Quadro M4000M
Windows 10 Pro 64Bit Version 1803
Build 17134.285
SWX2018-64Bit-SP5.0
MaxxDB 2018 SP0.56
DraftSight 2018 x64 SP2
3DCONNEXION SpaceMouse Enterprise mit CadMouse

erstellt am: 21. Mai. 2019 12:30    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 Rene82 10 Unities + Antwort hilfreich

Hallo René

wie sieht denn Dein Code aktuell aus?

------------------
Viele Grüße aus Brackenheim

Lars Pauly

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

Rene82
Mitglied



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

Beiträge: 11
Registriert: 14.05.2019

erstellt am: 21. Mai. 2019 12:37    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 Lars, hier bitte:

Dies ist der Aufbau den mir ConZept gegeben hat und ich versuche über den Object Browser dann die Befehle herauszusuchen und auszuprobieren, wenn die nicht funktionieren gehe ich zur Ausgangslage erstmal wieder zurück.

Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swview As SldWorks.View

Dim swModelExt As SldWorks.ModelDocExtension
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim swExportPDFData As SldWorks.ExportPdfData

Dim IRet    As Integer

Dim strFilename As String
Dim sTitle As String
Dim ValOut As String


Dim sZeichnungsnummer As String 'Zeichnungsnummer
Dim sRevision As String 'Revision
Dim sBeschreibung As String 'Beschreibung

Dim ResolvedValOut As String


Dim WasResolved As Boolean

Dim swModelName As String

Const sPfad As String = "W:\400_Name\410_Name1\Name2\Name3\010_Name4\"


Set swApp = Application.SldWorks
Set swDraw = swApp.ActiveDoc
Set swModel = swApp.ActiveDoc

'Set swView = swDraw.GetNextView
Set swview = swDraw.GetFirstView 'erste Ansicht auf der Zeichnung
Set swModel = swview.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

'********************** Properties *****************************
Const pZeichnungsnummer As String = "Zeichnungsnummer"
Const pRevision As String = "Revision"
Const pBeschreibung As String = "Beschreibung"
'***************************************************************

If swModel.GetType <> swDocDRAWING Then
MsgBox "Makro kann nur in Zeichnungen ausgeführt werden.", vbCritical
End 'Beendet das Makro
End If

sTitle = swModel.GetTitle

Set swModelExt = swModel.Extension
Set swCustPropMgr = swModelExt.CustomPropertyManager("")

'IRet = 1 wenn es die Eigenschaft nicht gibt / IRet = 2 wenn die Eigenschaft existiert
'Hole die Zeichnungsnummer
IRet = swCustPropMgr.Get5(pZeichnungsnummer, False, ValOut, ResolvedValOut, WasResolved)
sZeichnungsnummer = ValOut

'Hole die Revision
IRet = swCustPropMgr.Get5(pRevision, False, ValOut, ResolvedValOut, WasResolved)
sRevision = ValOut

'Hole die Beschreibung
IRet = swCustPropMgr.Get5(pBeschreibung, False, ValOut, ResolvedValOut, WasResolved)
sBeschreibung = ValOut

'Export to PDF if it is a drawing
'Hier brauchst du kein check mehr nach der Zeichnung, da dies schon am Anfang steht

strFilename = sPfad & sZeichnungsnummer & " " & sRevision & "_" & sBeschreibung & ".pdf"
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
MsgBox (sPath + strFilename)
End Sub

Gruß René

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

HenryV
Mitglied
Konstrukteur, Engineering


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

Beiträge: 698
Registriert: 18.05.2005

SolidWorks 2018 x64 SP4.0
Dell T3600 Workstation
Intel XENON 6x3.2 GHz
NVIDIA Quadro 4000 2 GB
16GB RAM
2x Dell U2412M, 24" TFT
Windows 7 Professional x64 SP1
Microsoft Office Pro 2010 SP2
Kaspersky Anti-Virus 10.2.4.674
Microsoft VB 2010 Express
SpacePilot von 3Dconnexion

erstellt am: 21. Mai. 2019 12:57    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 Rene82 10 Unities + Antwort hilfreich

@Spirou85
Da hast du was Falsch verstanden.Mit GetFirstView, bekommst du zwar schon die "erste" Ansicht auf der Zeichnung, aber die erste Ansicht ist das Blatt selber. Erst mit GetNextView bekommst du die erste Ansicht mit einem Modell. Zum selber überprüfen -> Get Drawing View Names and Types Example (VBA)

@Rene82
Du hast da ein Durcheinander und machst Sachen doppelt und dreifach.
z.B. setzt du
swModel = swApp.ActiveDoc  <- Zeichnung
dann
Set swModel = swview.ReferencedDocument  <- Referenziertes Modell
und zuletzt wieder
Set swModel = swApp.ActiveDoc  <- Zeichnung
Das kann nicht funktionieren.

Ich hab den Code einmal angepasst (Die unnötigen Variablendeklarationen hab ich mal drin gelassen).

Code:
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swview As SldWorks.View

    Dim swModelExt As SldWorks.ModelDocExtension
    Dim swConfigMgr As SldWorks.ConfigurationManager
    Dim swConfig As SldWorks.Configuration
    Dim swCustPropMgr As SldWorks.CustomPropertyManager
    Dim swExportPDFData As SldWorks.ExportPdfData

    Dim IRet    As Integer

    Dim strFilename As String
    Dim sTitle As String
    Dim ValOut As String

    Dim sZeichnungsnummer As String              'Zeichnungsnummer
    Dim sRevision As String                      'Revision
    Dim sBeschreibung As String                  'Beschreibung

    Dim ResolvedValOut As String
    Dim WasResolved As Boolean
    Dim swModelName As String

    Const sPfad As String = "W:\400_Name\410_Name1\Name2\Name3\010_Name4\"

    Set swApp = Application.SldWorks
    Set swDraw = swApp.ActiveDoc

    If swDraw.GetType <> swDocDRAWING Then
        MsgBox "Makro kann nur in Zeichnungen ausgeführt werden.", vbCritical
        End                                      'Beendet das Makro
    End If

    Set swview = swDraw.GetFirstView             'erste Ansicht auf der Zeichnung
    Set swview = swDraw.GetNextView
    Set swModel = swview.ReferencedDocument      'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil

    '********************** Properties *****************************
    Const pZeichnungsnummer As String = "Zeichnungsnummer"
    Const pRevision As String = "Revision"
    Const pBeschreibung As String = "Beschreibung"
    '***************************************************************

    sTitle = swModel.GetTitle

    Set swModelExt = swModel.Extension
    Set swCustPropMgr = swModelExt.CustomPropertyManager("")

    'IRet = 1 wenn es die Eigenschaft nicht gibt / IRet = 2 wenn die Eigenschaft existiert
    'Hole die Zeichnungsnummer
    IRet = swCustPropMgr.Get5(pZeichnungsnummer, False, ValOut, ResolvedValOut, WasResolved)
    sZeichnungsnummer = ValOut

    'Hole die Revision
    IRet = swCustPropMgr.Get5(pRevision, False, ValOut, ResolvedValOut, WasResolved)
    sRevision = ValOut

    'Hole die Beschreibung
    IRet = swCustPropMgr.Get5(pBeschreibung, False, ValOut, ResolvedValOut, WasResolved)
    sBeschreibung = ValOut

    'Export to PDF if it is a drawing
    'Hier brauchst du kein check mehr nach der Zeichnung, da dies schon am Anfang steht

    strFilename = sPfad & sZeichnungsnummer & " " & sRevision & "_" & sBeschreibung & ".pdf"
    Set swExportPDFData = swApp.GetExportFileData(1)
    Set swModel = swDraw
    swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
    MsgBox (sPath + strFilename)
End Sub



Gruss Andreas


------------------
21 ist nur die halbe Antwort.

[Diese Nachricht wurde von HenryV am 21. Mai. 2019 editiert.]

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

Rene82
Mitglied



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

Beiträge: 11
Registriert: 14.05.2019

erstellt am: 21. Mai. 2019 14:18    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 Andreas,

ja ich bin da noch sehr chaotisch unterwegs, aber da ich ein "little Stupid Newbie" verzeih mit bitte noch mein Chaos.

  Set swview = swDraw.GetFirstView            'erste Ansicht auf der Zeichnung
  Set swview = swview.GetNextView

Durch diese Funktion holt er tatsächlich die Werte aus dem Model,
Das Makro läuft durch holt sich auch die Werte aus dem Model, VIELEN DANK HIERFÜR - DANKE DANKE.

ABER: Er speichert jetzt keine PDF´s mehr ab! Gibt mir aber als Message es wäre abgespeichert unter der Pfadangabe. Wenn ich im Explorer nach schauen liegen keine erzeugten PDF-Dateien   

Grüße an Euch
René

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

HenryV
Mitglied
Konstrukteur, Engineering


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

Beiträge: 698
Registriert: 18.05.2005

SolidWorks 2018 x64 SP4.0
Dell T3600 Workstation
Intel XENON 6x3.2 GHz
NVIDIA Quadro 4000 2 GB
16GB RAM
2x Dell U2412M, 24" TFT
Windows 7 Professional x64 SP1
Microsoft Office Pro 2010 SP2
Kaspersky Anti-Virus 10.2.4.674
Microsoft VB 2010 Express
SpacePilot von 3Dconnexion

erstellt am: 21. Mai. 2019 14:38    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 Rene82 10 Unities + Antwort hilfreich

Da ist mir einer durch die Lappen gegangen.
Um die Zeichnung als PDF zu speichern, muss man das swDraw wieder dem swModel zuweisen.
Code:
...
Set swExportPDFData = swApp.GetExportFileData(1)
Set swModel = swDraw
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
MsgBox (sPath + strFilename)
...

Den Code oben hab ich auch ergänzt.

Gruss Andreas

------------------
21 ist nur die halbe Antwort.

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

Rene82
Mitglied



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

Beiträge: 11
Registriert: 14.05.2019

erstellt am: 21. Mai. 2019 14:53    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 Andreas, ConZept, Spirou85,

Vielen Lieben Dank für die Unterstützung beim Erstellen dieses Makros! - 1000 Dank!!

Hier nochmal der komplette Code:

Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swview As SldWorks.View

    Dim swModelExt As SldWorks.ModelDocExtension
    Dim swConfigMgr As SldWorks.ConfigurationManager
    Dim swConfig As SldWorks.Configuration
    Dim swCustPropMgr As SldWorks.CustomPropertyManager
    Dim swExportPDFData As SldWorks.ExportPdfData

    Dim IRet    As Integer

    Dim strFilename As String
    Dim sTitle As String
    Dim ValOut As String

    Dim sZeichnungsnummer As String              'Zeichnungsnummer
    Dim sRevision As String                      'Revision
    Dim sBeschreibung As String                  'Beschreibung

    Dim ResolvedValOut As String
    Dim WasResolved As Boolean
    Dim swModelName As String

    Const sPfad As String = "W:\Name1\Name2\Name3\Name4\Name5\"

    Set swApp = Application.SldWorks
    Set swDraw = swApp.ActiveDoc

    If swDraw.GetType <> swDocDRAWING Then
        MsgBox "Makro kann nur in Zeichnungen ausgeführt werden.", vbCritical
        End                                      'Beendet das Makro
    End If

    Set swview = swDraw.GetFirstView            'erste Ansicht auf der Zeichnung
    Set swview = swview.GetNextView
    Set swModel = swview.ReferencedDocument      'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil

    '********************** Properties *****************************
    Const pZeichnungsnummer As String = "Zeichnungsnummer"
    Const pRevision As String = "Revision"
    Const pBeschreibung As String = "Beschreibung"
    '***************************************************************

    sTitle = swModel.GetTitle

    Set swModelExt = swModel.Extension
    Set swCustPropMgr = swModelExt.CustomPropertyManager("")

    'IRet = 1 wenn es die Eigenschaft nicht gibt / IRet = 2 wenn die Eigenschaft existiert
    'Hole die Zeichnungsnummer
    IRet = swCustPropMgr.Get5(pZeichnungsnummer, False, ValOut, ResolvedValOut, WasResolved)
    sZeichnungsnummer = ValOut

    'Hole die Revision
    IRet = swCustPropMgr.Get5(pRevision, False, ValOut, ResolvedValOut, WasResolved)
    sRevision = ValOut

    'Hole die Beschreibung
    IRet = swCustPropMgr.Get5(pBeschreibung, False, ValOut, ResolvedValOut, WasResolved)
    sBeschreibung = ValOut

    'Export to PDF if it is a drawing
    'Hier brauchst du kein check mehr nach der Zeichnung, da dies schon am Anfang steht

    strFilename = sPfad & sZeichnungsnummer & "" & sRevision & "_" & sBeschreibung & ".pdf"
    Set swExportPDFData = swApp.GetExportFileData(1)
    Set swModel = swDraw
    swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
    MsgBox (sPath + strFilename)
End Sub

ICH DANKE EUCH WIE VERRÜCKT FÜR DIESE SUPER-COOLE-UNTERSTÜTZUNG!

Gruß René

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

Rene82
Mitglied



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

Beiträge: 11
Registriert: 14.05.2019

erstellt am: 18. Feb. 2020 16:30    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 an Alle,

ich bins mal wieder ;-) und hoffe das ich wieder auf eure Hilfe zurückgreifen kann!

Folgendes:
Ich habe mir mit Hilfe des obigen Makros (PDF-Erzeugung) und des Forums ein weiteres Makro "zusammengebastelt" - anders kann ich es leider nicht sagen.
-------------------------------------------------------
    Dim swApp                  As SldWorks.SldWorks
    Dim swModel                As SldWorks.ModelDoc2
    Dim swDraw                As SldWorks.DrawingDoc
    Dim swview                As SldWorks.View
    Dim swModelExt            As SldWorks.ModelDocExtension
    Dim swConfigMgr            As SldWorks.ConfigurationManager
    Dim swConfig              As SldWorks.Configuration
    Dim swCustPropMgr          As SldWorks.CustomPropertyManager
   
    Dim pdfoptions            As Long
    Dim sPathName              As String
    Dim nErrors                As Long
    Dim nWarnings              As Long
    Dim nRetval                As Long
    Dim bShowMap              As Boolean
    Dim bRet                  As Boolean
    Dim sFileName              As String
    Dim oConfig                As SldWorks.Configuration
    Dim ConfName              As String
    Dim Index                  As String
    Dim Ord                    As String
    Dim Antwort                As Integer
    Dim IRet                  As Integer
    Dim ValOut                As String
    Dim sTitle                As String
    Dim Step                  As Long
    Dim Iges                  As Long
   
    Dim Part As Object
    Dim boolstatus As Boolean
    Dim longstatus As Long, longwarnings As Long

    Dim sZeichnungsnummer As String              'Zeichnungsnummer
    Dim sRevision As String                      'Revision
    Dim sBeschreibung As String                  'Beschreibung
    Dim sProjekt As String                      'Projektname

    Dim ResolvedValOut As String
    Dim WasResolved As Boolean
    Dim swModelName As String
    Dim iTemp As Integer
    Dim ModelPathName As String
    Dim ActiveConfname As String
   
    Dim ModelDoc As Object
    Dim DrwFileName As String
    Dim DrwFullPath  As String
    Dim DrawingDoc As Object
    Dim errors As Long
    Dim warnings As Long
       
Sub main()


      '********************** Properties *****************************
    Const pZeichnungsnummer As String = "Zeichnungsnummer"
    Const pRevision As String = "Revision"
    Const pBeschreibung As String = "Beschreibung"
    Const pProjekt As String = "Projekt"
    '***************************************************************
   
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
   
iTemp = swModel.GetType
    If swModel.GetType <> swDocDRAWING Then
    ElseIf swModel.GetType <> swDocPART Then
    ElseIf swModel.GetType <> swDocASSEMBLY Then
        MsgBox "- SolidWorks Baugruppe, Teil oder Zeichnung öffnen -"
        End
    End If
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    sFileName = sProjekt & "" & sZeichnungsnummer & "" & sRevision & "_" & sBeschreibung

    sTitle = swModel.GetTitle

    Set swModelExt = swModel.Extension
    Set swCustPropMgr = swModelExt.CustomPropertyManager("")
    sTitle = swModel.GetTitle

    Set swModelExt = swModel.Extension
    Set swCustPropMgr = swModelExt.CustomPropertyManager("")


    'Auslesen einer Benutzerdefinierte Eigenschaft
    'IRet = swCustPropMgr.Get5(pEigenschaftsname, False, sEigenschaftswert, ResolvedValOut, WasResolved)
   
    'IRet = 1 wenn es die Eigenschaft nicht gibt / IRet = 2 wenn die Eigenschaft existiert
    'Hole die Zeichnungsnummer
    IRet = swCustPropMgr.Get5(pZeichnungsnummer, False, sZeichnungsnummer, ResolvedValOut, WasResolved)
   
    'Hole die Revision
    IRet = swCustPropMgr.Get5(pRevision, False, sRevision, ResolvedValOut, WasResolved)
   
    'Hole die Beschreibung
    IRet = swCustPropMgr.Get5(pBeschreibung, False, sBeschreibung, ResolvedValOut, WasResolved)
       
    'Hole die Projektnamen
    IRet = swCustPropMgr.Get5(pProjekt, False, sProjekt, ResolvedValOut, WasResolved)
 
' Punkt 1: Ordner erzeugen

Ord = "\\XXX\YYY\02_ZZZ\" & sProjekt & "_" & sZeichnungsnummer & "" & sRevision
If Dir(Ord, vbDirectory) <> "" Then
MsgBox "Ordner ist schon vorhanden"
Else
MkDir Ord
MsgBox "Ordner " & Ord & " angelegt"
End If

' Punkt 2: Step & IGES exportieren

    Step = swApp.SetUserPreferenceIntegerValue(swStepAP, 214)
    sFileName = sZeichnungsnummer & "" & sRevision & "_" & sBeschreibung
    sPathName = Ord & "\" & sFileName & ".step"
    Debug.Print sPathName
    bRet = swModel.SaveAs4(sPathName, _
      swSaveAsCurrentVersion, _
      swSaveAsOptions_Silent, _
            nErrors, _
            nWarnings)

    If bRet = False Then
        nRetval = swApp.SendMsgToUser2("Probleme mit dem Speichern als Step bzw. IgesDatei", swMbWarning, swMbOk)
       
    End If
   
    Iges = swApp.SetUserPreferenceIntegerValue(swIges, typ144)
    sFileName = sZeichnungsnummer & "" & sRevision & "_" & sBeschreibung
    sPathName = Ord & "\" & sFileName & ".igs"
    Debug.Print sPathName
    bRet = swModel.SaveAs4(sPathName, _
      swSaveAsCurrentVersion, _
      swSaveAsOptions_Silent, _
            nErrors, _
            nWarnings)

    If bRet = False Then
        nRetval = swApp.SendMsgToUser2("Probleme mit dem Speichern als Step bzw. IgesDatei", swMbWarning, swMbOk)
       
    End If
       
    MsgBox "Stepdatei und Iges-Datei erfolgreich gespeichert unter " & Ord & ""
   
    Path = Ord
    Shell "explorer.exe /e, " & Path, vbMaximizedFocus
   
End Sub
-------------------------------------------------------


Dieses Makro Funktioniert auch, es werden wahrscheinlich viele unnütze DIM - Einträge oben stehen die ich so nicht benötige.

Mein Ziel ist es diese Makro auch für PDF und DXF zu nutzen aber die zeichnungsdatei (.slddrw) enthält mehrere Blätter und es soll eine "automatische" Erkennung geben das Blatt 1 bis 5 die PDF wird und Blatt 6 - 7 die DXF, in einer anderen Zeichnung kann es nur Blaat1 für PDF sein und Blatt 2 für DXF. Und noch schöner wäre es wenn das Makro automatisch die zeichnung öffnet, wenn das "nur" das Model geöffnet ist. Nach der Erzeugung auch die Zeichnung woeder schließt. Grundlegend ist meine Vorstellung das man gefragt wird welche Blätter zur PDF und welche zur DXF gehören, oder man es an Blattnamen festmacht. PDF1, PDF2,...; DXF1; ... etc. Sobald im Blattnamen PDF steht soll es wissen PDF1 bis PDF5 zur PDF-Erzeugung gehört und DXF1 bis DXF8 zur DXF-Erzeugung gehört.

Habt ihr Ideen wie man es umsetzen kann! Ich bin über jede Hilfe froh und Dankbar und ich bin kein Makroschreiber - Ich probiere einfach immer aus ;-)

Grüße René

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

Rene82
Mitglied



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

Beiträge: 11
Registriert: 14.05.2019

erstellt am: 24. Feb. 2020 17:16    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,

hier nochmal verkürzt die Makrofunktionalität die ich nicht ohne eure Hilfe hinbekomme:!!!!


Solidworks --> Zeichnung ist geöffnet --> hole Benutzerdefinierte Eigenschaften --> erstelle einen Ordner (Name wird zusammengesetzt)--> speichere alle Blätter mit dem Namen PDF ab in einer Datei und dem erstelltem Ordner -->  Jetzt speichere alle Blätter mit dem Namen DXF1 .... DXF2 (etc.) in den selben Ordner ab, verwende dabei DXF Optionen --> Frage EINZELN oder Komplett DXF (mehrere Files oder nur eine DXF-File) --> ABSPEICHERN --> Öffne den Pfad mit den abgespeicherten Daten --> Öffne eine Exceldatei --> ENDE

Dank Stefan Berlitz´s Makro-Schnipsel kann man darüber den Blattnamen auslesen:

------------------------------------------------------------------------------

Sub main()

    Set SwApp = CreateObject("SldWorks.Application")
    Set DrawingDoc = SwApp.ActiveDoc
DrawingDoc.ActivateSheet ("DXF" & "PDF")

    If (DrawingDoc.GetType <> swDocDRAWING) Then
        ' wenn keine Zeichnung aktiv wird das Makro wieder beendet
        MsgBox "Nur für Zeichnungen geeignet"
        Exit Sub
    End If

    ' die Anzahl der Blätter holen, und dann in der Schleife eines nach
    ' dem anderen Abspeichern. Dazu ein Handle auf das aktuelle Blatt holen
    AnzahlBl = DrawingDoc.GetSheetCount
    Set Sheet = DrawingDoc.GetCurrentSheet

    ' damit die DXF anschließend im Verzeichnis der Zeichnung gespeichert werden
    ' muss der Pfad ermittelt werden. Ansonsten werden die DXFs im Verzeichnis
    ' des Makro gespeichert. Wenn man ein Sammelverzeichnis hat kann man das
    ' natürlich auch einfach direkt angeben
    temp = DrawingDoc.GetPathName
    ' da wir nur den Pfad brauchen alles andere abtrennen
    For i = Len(temp) To 1 Step -1
        If Mid$(temp, i, 1) = "\" Then
            pfad = Left(temp, i)
            Exit For
        End If
    Next i

    ' wenn mehr als ein Blatt da ist könnte es sein, dass wir nicht auf
    ' Blatt 1 sind. In einem Makro müssen wir jetzt einen Trick machen, um
    ' auf das erste Blatt zurückzukommen.
    ' Dazu immer wieder ein Blatt zurückspringen und dabei den Blattnamen
    ' vergleichen; wenn der gleich bleibt haben wir das erste Blatt erreicht.
    SheetName = Sheet.GetName
    For i = 1 To AnzahlBl - 1
        DrawingDoc.SheetPrevious
        Set Sheet = DrawingDoc.GetCurrentSheet
        If (SheetName = Sheet.GetName) Then
            Exit For
        End If
        SheetName = Sheet.GetName
    Next i

    ' jetzt sind wir garantiert auf dem ersten Blatt und können jetzt eins
    ' nach dem anderen Abspeichern
    msgtxt = ""

    For i = 1 To AnzahlBl

        ' nur den Dokumentnamen holen (der in der Titelzeile von SolidWorks
        ' angezeigt wird)
        Titel = DrawingDoc.GetTitle
        MsgBox DrawingDoc.GetPathName
        ' und die Endung mit dem .slddrw abschneiden, wenn vorhanden
        If (InStr(Titel, ".sld") > 0) Then
          Datei = Left(Titel, InStr(Titel, ".sld") - 1)
        Else
          Datei = Titel
        End If
       
                ' *** hier steht jetzt in Datei der Name ***
        If InStr(1, Datei, "DXF") > 0 Then
            ' dann Blatt1 auslassen
            MsgBox "Blatt mit DXF im Namen ausgelassen"
   Else            ' ***
          
            ' wir wollen alle Blätter als DXF mit den eingestellten Optionen abspeichern
            ' hier könnte auch z.B. einfach durch Umbenennen der Endung das Blatt als
            ' DWG (".dwg") oder TIFF (".tif") gespeichert werden. dabei werden aber
            ' jeweils die aktuellen Exportparameter benutzt, also würden z.B. alle
            ' TIFFs in derselben Größe abgespeichert.
            Datei = pfad & Datei & ".dxf"
          
            ' dann erfolgt das Speichern, die Parameter sind:
            ' DrawingDoc.SaveAs2 ( newName, unused, saveAsCopy, silent )
            ' wenn alles geklappt hat, wird eine 0 zurückgeliefert, ansonsten ein
            ' Wert ungleich 0
            If (DrawingDoc.SaveAs2(Datei, 0, True, False)) Then
                MsgBox "FEHLER BEIM SPEICHERN VON " & Datei & Chr$(10) & Chr$(13)
                msgtxt = msgtxt & "*** FEHLER bei: " & Datei & Chr$(10) & Chr$(13)
            Else
                msgtxt = msgtxt & "erfolgreich gespeichert: " & Datei & Chr$(10) & Chr$(13)
            End If
        End If
    
        ' und wenn noch Blätter kommen dieses aktivieren
        If AnzahlBl > i Then
            DrawingDoc.SheetNext
        End If
       
        'Spring zurück auf das erste Zeichnungsblatt
          DrawingDoc.SheetPrevious
        Set Sheet = DrawingDoc.GetCurrentSheet
        If (SheetName = Sheet.GetName) Then
            Exit For
        End If
        SheetName = Sheet.GetName
       
    Next i

    ' und noch die Zusammenfassung übers Speichern ausgeben
    MsgBox msgtxt
End Sub
------------------------------------------------------------
  

Grüße der hilfesuchende René  

[Diese Nachricht wurde von Rene82 am 24. Feb. 2020 editiert.]

[Diese Nachricht wurde von Rene82 am 24. Feb. 2020 editiert.]

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

bk.sc
Ehrenmitglied V.I.P. h.c.
Konstrukteur Sondermaschinenbau



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

Beiträge: 2354
Registriert: 18.07.2012

-Solid Works 2019 SP3
-Pro Engineer WF 3

erstellt am: 25. Feb. 2020 15:28    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 Rene82 10 Unities + Antwort hilfreich

Hallo Rene,

kannst du lieber kurz zusammenfassen was schon geht und woran es genau hapert? Weil dann könnten wir dir wahrscheinlich schneller Beispiele nennen oder dir den richtigen Wink geben.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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