Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  SolidWorks
  Abgeleitete Skizze per Makro umbenennen und verknüpfen

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
  
Gut zu wissen: SOLIDWORKS - DFMXpress
Autor Thema:   Abgeleitete Skizze per Makro umbenennen und verknüpfen (1054 mal gelesen)
Stefan65
Mitglied
Werkzeugkonstrukteur


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

Beiträge: 48
Registriert: 14.02.2014

Dell Precision 5820
Windows 10 Enterprise 64bit
Intel Xeon W-2123 @ 3.60GHz
16GB RAM
NVIDIA Quadro P2000
SolidWorks 2018 SP5
DBWorks-R17 SP2.5

erstellt am: 30. Dez. 2015 12: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


Masterskizze.JPG

 
Hallo zusammen,
wir verwenden für unsere Konstruktion von Stanz und Umformwerzeugen eine Masterskizze mit der wir unsere Werkzeuge steuern.
Die Masterskizze besteht aus vielen einzelnen Skizzen für Außenmaße, Verschraubungen, Stiftpositionen usw (siehe Bild). Diese einzelnen Skizzen leiten wir dann in die entsprechenden Platten ab und verwenden diese dann für weitere Bearbeitungen. Die Vorgehensweise ist immer die selbe, zuerst werden in der Baugruppe die einzelnen Skizzen in die entsprechenden Platten abgeleitet. Anschließend werden die einzelnen Platten geöffnet, die Abgeleitete Skizze wird umbenannt (da sie ja nur Skizze.. heißt) und bekommt den gleichen Namen wie die Skizze aus der Masterskizze. Zum Schluss wird die Skizze noch verknüpft damit sie nicht mehr verschoben werden kann. Jede einzelne Skizze hat eine Mittellinie (Konstruktionslinie) wo der linke Punkt der Linie mit der Ebene Rechts Deckungsgleich und die Linie selbst mit der Eben Vorne Kollinear verknüpft wird. Ich versuche die letzten beiden Schritte, Skizze umbenennen und Verknüpfen, per Makro zu lösen. Das Umbenennen bekomme ich hin aber das Verknüpfen nicht. Wie kann ich das in dem Makro lösen?


Option Explicit
    Dim swApp                  As SldWorks.SldWorks
    Dim swModel                As SldWorks.ModelDoc2
    Dim swModDocExt            As SldWorks.ModelDocExtension
    Dim swSelMgr                As SldWorks.SelectionMgr
    Dim swFeat                  As SldWorks.Feature
    Dim swComp                  As SldWorks.Component2
    Dim vModelPathName          As Variant
    Dim vComponentPathName      As Variant
    Dim vFeature                As Variant
    Dim vDataType              As Variant
    Dim vStatus                As Variant
    Dim vRefEntity              As Variant
    Dim vFeatComp              As Variant
    Dim nConfigOpt              As Long
    Dim sConfigName            As String
    Dim nRefCount              As Long
    Dim nSelType                As Long
    Dim i                      As Long
    Dim boolstatus              As Boolean
    Dim NeuerName              As String
    Dim swSketch                As SldWorks.Sketch
    Dim bValue                  As Boolean
    Dim swSketchMgr            As SldWorks.SketchManager

Sub main()
   
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
   
    If swModel Is Nothing Then
        swApp.SendMsgToUser2 "Es ist kein Einzelteil geöffnet!", swMbInformation, swMbOk
        ClearObjects
        Exit Sub
    End If
   
    If (swModel.GetType <> swDocPART) Then
        swApp.SendMsgToUser2 "Dieses Makro funktioniert nur bei Einzelteilen!", swMbInformation, swMbOk
        ClearObjects
        Exit Sub
    End If
   
    Set swSelMgr = swModel.SelectionManager
    Set swModDocExt = swModel.Extension
    nSelType = swSelMgr.GetSelectedObjectType3(1, -1)
   
    Set swFeat = swSelMgr.GetSelectedObject6(1, -1)
 
   
    If swFeat Is Nothing Then
        swApp.SendMsgToUser2 "Bitte erst die Abgeleitete Skizze makieren die umbenannt werden sollen!", swMbInformation, swMbOk
        ClearObjects
        Exit Sub
    End If
   
    Debug.Print "Model name = " + swModel.GetPathName
   
    nSelType = swSelMgr.GetSelectedObjectType3(1, -1)

    nRefCount = swModDocExt.ListExternalFileReferencesCount
    swModDocExt.ListExternalFileReferences vModelPathName, vComponentPathName, vFeature, vDataType, vStatus, vRefEntity, vFeatComp, nConfigOpt, sConfigName
     
    Debug.Print "    Reference count        = " + Str(nRefCount)
    'MsgBox nRefCount
   
    If nRefCount = 0 Then
        swApp.SendMsgToUser2 "Es kann nichts umbenannt werden da dies keine Abgeleitete Skizze ist!", swMbInformation, swMbOk
        ClearObjects
        Exit Sub
    End If
   
    If vComponentPathName(i) = "" Then
        swApp.SendMsgToUser2 "Die Baugruppe muss im Hintergrund geöffnet sein sonst kann die Abgeleitete Skizze nicht umbenannt werden!", swMbInformation, swMbOk
        ClearObjects
        Exit Sub
    End If
   

   
    Select Case nSelType
        ' Selected component in an assembly document
        Case swSelCOMPONENTS
            Set swComp = swSelMgr.GetSelectedObjectsComponent3(1, -1)
            nRefCount = swComp.ListExternalFileReferencesCount
            swComp.ListExternalFileReferences2 vModelPathName, vComponentPathName, vFeature, vDataType, vStatus, vRefEntity, vFeatComp, nConfigOpt, sConfigName

        Set swModel = swComp.GetModelDoc2
        ' Selected feature in a part or assembly document
        Case swSelBODYFEATURES, swSelSKETCHES
            Set swFeat = swSelMgr.GetSelectedObject6(1, -1)
            nRefCount = swFeat.ListExternalFileReferencesCount
          swFeat.ListExternalFileReferences2 vModelPathName, vComponentPathName, vFeature, vDataType, vStatus, vRefEntity, vFeatComp, nConfigOpt, sConfigName
       
        ' Part document only
        Case Else
            nRefCount = swModDocExt.ListExternalFileReferencesCount
            swModDocExt.ListExternalFileReferences vModelPathName, vComponentPathName, vFeature, vDataType, vStatus, vRefEntity, vFeatComp, nConfigOpt, sConfigName
    End Select
   
    If nRefCount = 0 Then
        swApp.SendMsgToUser2 "Es kann nichts umbenannt werden da dies keine Abgeleitete Skizze ist!", swMbInformation, swMbOk
        ClearObjects
        Exit Sub
    End If
   
    Debug.Print "    Component path + name  = " + vComponentPathName(i)
    Debug.Print "Model name = " + swModel.GetPathName
    Debug.Print "    Reference count        = " + Str(nRefCount)
    Debug.Print ""
    'For i = 0 To nRefCount - 1
        Debug.Print "    Model path + name      = " + vModelPathName(i)
        Debug.Print "    Component path + name  = " + vComponentPathName(i)
        Debug.Print "    Feature                = " + vFeature(i)
        Debug.Print "    Data type              = " + vDataType(i)
        Debug.Print "    Status                = " + Str(vStatus(i))
        Debug.Print "    Reference entity      = " + vRefEntity(i)
        Debug.Print "    Feature component      = " + vFeatComp(i)
        Debug.Print "    Configuration option  = " & nConfigOpt
        Debug.Print "    Configuration name    = " & sConfigName
        Debug.Print " "
       
        NeuerName = vRefEntity(i)
        'MsgBox NeuerName
        NeuerName = Left(NeuerName, VBA.InStr(1, NeuerName, "von") - 2)
        'MsgBox NeuerName
        boolstatus = swModel.Extension.SelectByID2(vFeature(i), "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
        boolstatus = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, NeuerName)
       
        swModel.ClearSelection2 True
        Set swSketchMgr = swModel.SketchManager
       
        bValue = swModel.Extension.SelectByID2(NeuerName, "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
        swSketchMgr.InsertSketch False
        Set swSketch = swModel.GetActiveSketch2

        ' Skizze Verknüpfen?????

        swSketchMgr.InsertSketch True
    'Next i
   
    ClearObjects
   
End Sub

Function ClearObjects()

    Set swApp = Nothing
    Set swModel = Nothing
    Set swSelMgr = Nothing
    Set swModDocExt = Nothing
    Set swFeat = Nothing

End Function


Vielen Dank
Gruß Stefan

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

Stefan65
Mitglied
Werkzeugkonstrukteur


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

Beiträge: 48
Registriert: 14.02.2014

Dell Precision 5820
Windows 10 Enterprise 64bit
Intel Xeon W-2123 @ 3.60GHz
16GB RAM
NVIDIA Quadro P2000
SolidWorks 2018 SP5
DBWorks-R17 SP2.5

erstellt am: 08. Jan. 2016 13:50    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


AbgeleiteteSkizzenumbenennen.swp.txt

 
Hallo zusammen,
nach langem probieren ist es mir nun doch gelungen die abgeleitete Skizze auch zu verknüpfen. Anbei das neue Makro.

Gruß Stefan

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