---

Ich habe verschiedene Makros, die von einer Zeichnung auf das referenzierte Modell, bzw. Baugruppe zugreifen. Dabei stört es mich, das dabei immer das Modell eingeblendet wird. Kennt jemand einen Trick, das zu vermeiden, und sozusagen "still und heimlich" auf das Modell zuzugreifen?

Mein Code sieht so aus:

    ' Hier wird geprüft, ob das aktive Dokument eine Zeichnung ist (GetType=3)
    ' Wenn Model eine Zeichnung ist, wird das von der Zeichnung referenzierte
    ' Dokument aktiviert
    If Model.GetType = swDocDRAWING Then
        Set retval = Model.GetFirstView    ' FirstView ist das Blatt
        Set view = retval.GetNextView      ' Dies ist die erste Ansicht
       
        If view Is Nothing Then
            Exit Sub
        End If
        ' Name des referenzierten Modells holen / gets referenced model's name
        RefModelName = view.GetReferencedModelName

        ' Referenziertes Modell zum aktiven Dokument machen / activates referenced model
        Set reference = swApp.ActivateDoc2(RefModelName, True, nErrors)

Piet

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

---

nimm swApp.OpenDoc6 statt swApp.ActivateDoc2

------------------
mfg uc

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

---

Vielen Dank, das klappt einwandfrei. Die Online-Hilfe gibt auch genau das Beispiel wieder, das ich brauche.

Piet

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

---

Und noch eine Alternative ....

passt zwar nicht ganz aber vielleicht kann es ja mal jmd. gebrauchen

Sub Test
Dim myMod As ModelDoc2
Dim myType As swDocumentTypes_e

'fyi: SW startet unsichtbar falls es noch nicht gestartet wurde -----
'fyi2: kein support von SW wenn man das ModelDoc so anbindet.
Set myMod = GetModel("D:\SolidWorks\samples\tutorial\fillets\knob.sldprt")
 
  myType = myMod.GetType
  If myType = swDocASSEMBLY Then
  'blubb
  ElseIf myType = swDocDRAWING Then
    'Vorsicht bei Drawings .....
    'z.b. Die 'Richtigen' Referenzen gibt es nur wenn das DRW geöffnet ist....
  ElseIf myType = swDocNONE Then
    'blubb
  ElseIf myType = swDocPART Then
    'blubb
  ElseIf myType = swDocSDM Then
    'blubb
  Else
    Err.Raise -1 + vbObjectError, "SW", "no doc type"
  End If
Stop

  Set myMod = Nothing
End Sub
Private Function GetModel(ByVal sfile As String) As ModelDoc2
On Error Resume Next
  Set GetModel = GetObject(sfile)
  If Err.Number <> 0 Then
    MsgBox Err.Number & " " & Err.Description, vbInformation + vbOKOnly, "Fehler"
  End If
End Function

Gruß
Micha

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

Zitat:

---

Interpunktion und Orthographie des Postings sind frei erfunden.
Eine Übereinstimmung mit aktuellen oder ehemaligen Regeln wäre rein zufällig und ist nicht beabsichtigt.

---

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

---

@Piet

Versuche garade das gleiche. Funktioniert aber nicht so richtig.

Möchte vom referenzierten Modell eine Eigenschaft
(GetCustomInfoValue) auslesen. Bekomme diese aber nur ausgelesen,
wenn das Modell eingeblendet ist.

Kannst du noch eine Fortsetzung vom Makro reinstellen?

------------------
( Um an die Quelle zu kommen, muss man gegen den Strom schwimen  )

OM

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

---

' ******************************************************************************
' Revisionskopien speichern
' This macro saves a copy of the actual doc in the same folder for documentation.
' If the doc is a drawing, the referenced model can be saved as copy, too.
' A revision index is attached to the filename.
' P. Sach
' Version 1.0  21.10.05
' Version 1.1  30.11.05    Referenziertes Modell wird still geöffnet
' ******************************************************************************
Option Explicit
Public Index As String
Public Anhang As String
Public NewName As String
Public swApp As Object
Public Model As Object
Public reference As Object
Public OldName As String
Public ShortOldName As String
Public activetype As Integer
Public reftype As Integer
Public RefModelName As String
Public refname As String
Public ShortRefName As String
Public prtenabled As Boolean
Public drwenabled As Boolean
Public assyenabled As Boolean
Public Const swStepAP = 75
Public nErrors As Long
Public nWarnings As Long

'Public Enum OpenDocOptions_e
Public Const swOpenDocOptions_Silent = 1
Public Const swOpenDocOptions_ReadOnly = 2
Public Const swOpenDocOptions_ViewOnly = 4
Public Const swOpenDocOptions_RapidDraft = 8
Public Const swOpenDocOptions_LoadModel = 16
Public Const swOpenDocOptions_AutoMissingConfig = 32

'Public Enum DocumentTypes_e
Public Const swDocNONE = 0
Public Const swDocPART = 1
Public Const swDocASSEMBLY = 2
Public Const swDocDRAWING = 3
Public Const swDocSDM = 4

Sub main()
    Dim nErrors As Long
    Dim nWarnings As Long
    Dim nretval As Long
         
    Set swApp = Application.SldWorks
'    Set swApp = CreateObject("SldWorks.Application")                      ' an SolidWorks anklinken
    Set Model = swApp.ActiveDoc
   
    If Model Is Nothing Then                                            ' Wenn kein Dokument offen ist,
            MsgBox ("Kein SolidWorks-Dokument geöffnet")                ' Meldung
            Exit Sub                                                    ' und raus
    End If
   
    OldName = Model.GetPathName()                                  ' Pfadnamen auslesen / get path name
    ShortOldName = Left(OldName, Len(OldName) - 7)            ' Dateiendung abschneiden / cutoff ".slddrw"
    activetype = Model.GetType
       
    If (Model.GetType = swDocDRAWING) Then
        activetype = 3                  ' Wenn Zeichnung, dann
        getreftype                      ' Typ des referenzierten Modells holen
    ElseIf (Model.GetType <> 3) Then
        refname = OldName              ' wenn aktives Doc ein Teil oder Assy ist / if active doc is a part or assy
        Set reference = swApp.ActiveDoc
    End If
   
    If Model.EditRebuild3() Then          ' Anzeige der Zeichnungsansichten aktualisieren / rebuild
    Else
        MsgBox "This model has rebuild errors!"
    End If
    frmEingabe.Show                        ' ruft das Eingabefenster auf
End Sub

Sub getreftype()                            ' ermittelt das in einer Zeichnung refenzierte Modell / gets the referenced model in a drawing
    Dim view As Object                      ' und dessen Namen incl. Pfad / and it's filename and path
    Dim bRetval As Boolean
    Dim nErrors As Long
    Dim nWarnings As Long
    Dim retval As Object
    Dim nDocType As Long

    ' Hier wird geprüft, ob das aktive Dokument eine Zeichnung ist (GetType=3)
    ' Wenn Model eine Zeichnung ist, wird das von der Zeichnung referenzierte
    ' Dokument aktiviert
    If Model.GetType = swDocDRAWING Then
        Set retval = Model.GetFirstView    ' FirstView ist das Blatt
        Set view = retval.GetNextView      ' Dies ist die erste Ansicht
       
        If view Is Nothing Then
            Exit Sub
        End If
        ' Name des referenzierten Modells holen / gets referenced model's name
        RefModelName = view.GetReferencedModelName
   
        ' Typ des referenzierten Docs anhand der Endung erkennen
        If InStr(LCase(RefModelName), "sldprt") > 0 Then    ' LCase wandelt string in Kleinbuchstaben um
            nDocType = swDocPART                            ' InStr gibt die Position des Suchtextes zurück
        ElseIf InStr(LCase(RefModelName), "sldasm") > 0 Then
            nDocType = swDocASSEMBLY
        ElseIf InStr(LCase(RefModelName), "slddrw") > 0 Then
            nDocType = swDocDRAWING
        Else
            ' Probably not a SolidWorks file...
            nDocType = swDocNONE
            MsgBox ("Referenzdatei kann nicht geöffnet werden")
            Exit Sub
        End If

        ' Referenziertes Modell zum aktiven Dokument machen / activates referenced model
        ' Set reference = swApp.ActivateDoc2(RefModelName, True, nErrors)
        Set reference = swApp.OpenDoc6(RefModelName, nDocType, swOpenDocOptions_Silent, "", nErrors, nWarnings)
        refname = reference.GetPathName()
        reftype = reference.GetType
        If (reftype < 1 Or reftype > 2) Then
            MsgBox ("Kein Referenztyp gefunden")
        End If
        ' Damit ist alles über das refernzierte Doc bekannt
        ' Zeichnung wieder zum aktuellen Dokument machen / activates drawing again
        Set Model = swApp.ActivateDoc2(OldName, True, nErrors)
    End If

End Sub

Das Öffnen des referenzierten Modells findet in der sub getreftype() statt. Ich hoffe, das hilft dir weiter.

Piet

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

---

Revspeichern.zip

Was soll's ich hab mal mein ganzes Makro angehängt.

Piet

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

---

Vorsicht mit OpenDoc6() ohne Aktivierung des Dokuments!
Man erhält hier zwar ein ModelDoc2-Objekt, es kann
aber manchmal sein, das einige Aktionen mit diesem
Objekt ein aktives ModelDoc benötigen.

Soll heißen, ActivateDoc() muß in manchen Fällen unbedingt aufgerufen werden damit das gewünschte auch korrekt von SW abgearbeitet wird.

Nur so für den Hinterkopf.

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

---

Hallo Piet,

Danke, funktioniert aber leider nicht. Könnte mit dem Problem zusammenhängen welches mkkk geschrieben hat.

Die Funktion bringt zwar zwischenzeitig keine Fehlermeldung mehr, doch leider kann die Eigenschaft nicht ausgelesen werden. Was solls, wird das Modell hat kurz eingeblendet.

Habe übrigens das gleiche wie du gemacht, auch ein automatischer Export, aber nur für TIFF und DXF von einer Zeichnung.
Habe aber die Einstellungen für das TIFF bez. DXF per Makro vorgenommen (Optionen wie DPI etc.)

Hat doch nocht funktioniert. Danke Piet, gibt 10!

------------------
(  Um an die Quelle zu kommen, muss man gegen den Strom schwimen   )

OM

[Diese Nachricht wurde von Oberli Mike am 01. Dez. 2005 editiert.]

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

---

Hallo Piet, melde mich nochmals.

Wenn du interesse hast, die Einstellungen für den Export zu verfeienrn, hier die Befehle, welche funktionieren sollten.

TIFF-Optionen
retval = swApp.SetUserPreferenceIntegerValue(swTiffScreenOrPrintCapture, 1)
retval = swApp.SetUserPreferenceIntegerValue(swTiffImageType, 0)
retval = swApp.SetUserPreferenceIntegerValue(swTiffCompressionScheme, 2)
retval = swApp.SetUserPreferenceIntegerValue(swTiffPrintDPI, 300)
retval = swApp.SetUserPreferenceIntegerValue(swTiffPrintPaperSize, blattsize)
retval = swApp.SetUserPreferenceIntegerValue(swTiffPrintScaleFactor, 100)

DXF-Optionen
retval = swApp.SetUserPreferenceIntegerValue(swDxfVersion, 2) ' Version
retval = swApp.SetUserPreferenceIntegerValue(swDxfOutputFonts, 1) 'Schriftart
linestyle = swApp.SetUserPreferenceIntegerValue(swDxfOutputLineStyles, 1) 'Linienarten
retval = swApp.SetUserPreferenceIntegerValue(swDxfOutputNoScale, 1) 'Aktivieren Ausgabemassstab 1:1
retval = swApp.SetUserPreferenceStringListValue(swDxfMappingFiles, "\\chprcbap01\users\3D_DATEN\SWX\SolidWorksVorlagen2006\Systemeinstellungen\SWX\farbdefinition_me10.dat") 'Abbildungsdatei
retval = swApp.SetUserPreferenceToggle(swDXFDontShowMap, True) 'Abbildung nicht bei jedem Speichern anzeigen
retval = swApp.SetUserPreferenceToggle(swDxfMapping, True) ' Aktivieren Abbildungsdatei
retval = swApp.SetUserPreferenceIntegerValue(swDxfMultiSheetOption, 0) 'Zeichnung mit mehreren Blättern

Je nach Bedürfnis kann in jeder Option der zweite Wert in der Klammer verändert werden.

Bei mir haben diese Befehle erst ab der Version SWX2006 funktioniert.
In SWX2005 erst seit ich auf dem gleichen Rechner SWX2006 istalliert habe.

------------------
( Um an die Quelle zu kommen, muss man gegen den Strom schwimen  )

OM

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

---

Sehr elegant, Mike, danke und 10 zurück!

Piet

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