---

Hallo zusammen!

Ich habe mir ein Makro geschrieben, mit dem ich innerhalb eine Baugruppe eine virtuelles Teil oder Baugruppe auswählen kann. Die virtuelle Komponente wird umbenannt, einmal geöffnet und Infos in die Properties geschrieben und soll dann anschließend extern unter diesem Namen gespeichert werden. In der API-Hilfe gibt es dazu ein Beispiel, dieses funktioniert jedoch nicht. In der API-Hilfe habe ich auch keine Hinweise auf SaveVirtualComponent gefunden. Ein Bug? Die virtuelle Komponente darf nicht geöffnet werden und von dort aus gespeichert werden, da die externen Referenzen sonst hinüber werden. Über diesen Weg ist es mir möglich virtuelle Komponenten unter einer neuen Dateinamen zu speichern, der automatisch vergeben werden kann.

Dann noch eine Frage, gibt es eine Möglichkeit, Infos in die Eigenschaften zu schreiben ohne das Teil oder Baugruppe öffnen zu müssen?

Danke, Klaus.

Code:

---

Sub znumgen_bg()
  Set swApp = CreateObject("SldWorks.Application")
  Set swModel = swApp.ActiveDoc
   
  ZEICHNUNGS_DIN_NR = neueWDNr()
  ' Wenn keine Zeichnung auf ist, dann Abbruch
  If swModel Is Nothing Then Exit Sub
   
  swxTyp = swModel.GetType
  Set swSelMgr = swModel.SelectionManager
  swSelCount = swSelMgr.GetSelectedObjectCount2(0)
   
  If swxTyp = swDocASSEMBLY And swSelCount = 1 Then
    Set swComp = swSelMgr.GetSelectedObject6(1, 0)
    If swComp.IsVirtual = True Then
      Debug.Print "eine virtuelle Komponente " & swComp.Name2 & " ausgewählt"
       
        Dim objFSO As Object
        Dim objFile As Object

        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFile = objFSO.GetFile(swModel.GetPathName)

        compName = objFSO.GetParentFolderName(objFile) & "\" & ZEICHNUNGS_DIN_NR

        If swComp.GetModelDoc2.GetType = swDocPART Then
            compName = compName & ".sldprt"
        Else
            compName = compName & ".sldasm"
        End If

        'Debug.Print "Name of saved virtual component: " & compName
        'swComp.SaveVirtualComponent compName
        swComp.Name2 = ZEICHNUNGS_DIN_NR
       
        Set swCompModel = swApp.ActivateDoc2(swComp.GetPathName, True, nRetval)
        Set swModel = swApp.ActiveDoc
        Set swConfigMgr = swModel.ConfigurationManager
        Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
       
        swAddInfo
       
        swApp.CloseDoc swModel.GetTitle
    End If
  End If
  
  '# Abräumen
  If Not swConfigMgr Is Nothing Then Set swConfigMgr = Nothing
  If Not swCustPropMgr Is Nothing Then Set swCustPropMgr = Nothing
  If Not swModel Is Nothing Then Set swModel = Nothing
  If Not swSelMgr Is Nothing Then Set swSelMgr = Nothing
  If Not swApp Is Nothing Then Set swApp = Nothing
  If Not objFSO Is Nothing Then Set objFSO = Nothing
  If Not objFile Is Nothing Then Set objFile = Nothing

End Sub

---

[Diese Nachricht wurde von riesi am 12. Mai. 2011 editiert.]

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

---

Hallo Klaus,
über den Dokumentmanager kannst du die Dateieigenschaften lesen/schreiben ohne die Datei zu öffnen. Beim Schreiben darf die Datei jedoch nicht schreibgeschützt sein.
Hier ein Auszug aus einem Makro von mir zum Lesen (GetCustomProperty) - Schreiben mit Set...:

    Set swClassFact = CreateObject("SwDocumentMgr.SwDMClassFactory")
    Set swDocMgr = swClassFact.GetApplication(sLicenseKey)
    Set FSO = CreateObject("Scripting.FileSystemObject")

    Open sListendatei For Input As #1
    Do While Not EOF(1)  ' Schleife bis Dateiende.
      Line Input #1, DateinameL
      Params = Split(DateinameL, vbTab)  ' params(0) = Dateiname ; params(1) = Konfig ; params(2) = MatNr
       
        'attr = "Normal is 0" "Read Only is 1" "Hidden is 2" "System is 4"
        Set fil = FSO.GetFile(Params(0))
        Attribut = fil.Attributes
        fil.Attributes = 0      'Schreibschutz aufheben
        Set fil = Nothing
       
        If InStr(UCase(Params(0)), "SLDPRT") Then
            nDocType = swDmDocumentPart
        ElseIf InStr(UCase(Params(0)), "SLDASM") Then
            nDocType = swDmDocumentAssembly
        ElseIf InStr(UCase(Params(0)), "SLDDRW") Then
            nDocType = swDmDocumentDrawing
        Else
            Exit Do
        End If
               
        Set swDoc = swDocMgr.GetDocument(Params(0), nDocType, False, nRetVal)  ': Debug.Assert swDmDocumentOpenErrorNone = nRetVal
        If nRetVal = 0 Then
            Set swCfgMgr = swDoc.ConfigurationManager
            If (Not (swCfgMgr Is Nothing)) Then
                    Set swCfg = swCfgMgr.GetConfigurationByName(Params(1))
                    swCfg.SetCustomProperty "Materialnummer", Params(2)
                    'sCustPropStr = swCfg.GetCustomProperty("Materialnummer", swDmCustomInfoText)
                    swDoc.Save
                    swDoc.CloseDoc
            End If
        End If
       
        Set fil = FSO.GetFile(Params(0))
        fil.Attributes = 1      'Schreibschutz wieder setzen
        Set fil = Nothing

    Loop

Close #1

MsgBox "Materialnummern aus Liste eingetragen."

Gruß Bernd

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

---

Guten Morgen Bernd!

Vielen Dank für den Code. Ich habe gestern nochmal ein wenig gesucht und so wie ich das sehe, ist die gewünschte Funktion SaveVirtualComponent erst in der 2011'er Version implementiert worden, aber schon in der 2010'er als Beispiel aufgeführt. 

Damit erübrigt sich auch die Arbeit mit dem Documentmanager erstmal, da ich die virtuelle Komponente vorher nicht speichern kann.

Gruß, Klaus.

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