Hallo ihr alle!
Hier beginne ich mit der Erstellung einer automatischen Zeichnung für Blechteile in Solidworks 2020 SP4
Ich kann bestimmte Ansichten automatisch importieren: vorne, links, rechts... Die Funktion zum Importieren der aufgeklappten Zustandsansicht kann jedoch nicht gefunden werden. Haben Sie eine Idee?
Ich möchte auch, dass die Rippchen automatisch mit der Aussicht ankommen und ich habe keines von beiden gefunden ...
Vielen Dank für Ihre Hilfe!
Hallo
Dies kann funktionieren, wenn das Referenzteil eine bestimmte "sm-flat"-Konfiguration hat, die der Plan jedes Mal finden kann.
Dann hängt die "magische" Bewertung mit der Art und Weise zusammen, wie das Teil konstruiert wurde.
Vielen Dank für Ihre Antwort!
Die spezifische Konfiguration meines entfalteten Zustands ist "SM-FLAT-PATTERN", kann das funktionieren? Und wie bitte?
Ich bin dir beim zweiten Satz nicht gefolgt.
Vielen Dank!
Hallo
Die Abwicklungskonfiguration existiert erst, wenn Sie eine Zeichnung mit einer abgewickelten erstellt haben, und dann müssen alle Ihre Blechteile auf die gleiche Weise erstellt werden.
Vielen Dank für Ihre Antwort!
Wenn ich also dem ersten Teil Ihres Satzes folge, ist es nicht möglich, aber der Rest sagt mir, dass es möglich ist? Haben Sie ein Verfahren, das Sie befolgen müssen? Irgendeine Möglichkeit, mir bitte zu geben?
Ich würde diese "automatische Zeichnung " nur für einfache Blechteile verwenden, die wie das Ausgangsteil aussehen
Vielen Dank!
Es ist unmöglich, eine vordefinierte Zeichnung mit dem Flat-Pattern bis zur Version 2019 für die 2020 zu machen. Ich würde nichts sagen, aber meiner Meinung nach dasselbe.
Die einzige Lösung, um diese entfaltete Ansicht automatisch zu erreichen, besteht darin, ein Makro zu erstellen.
Ein Beispiel für ein Makro, das ich aus dem Blechteil verwende und bei dem ich die Zeichnung der Musterfläche erstelle und sie entsprechend dem MEP-Blech auf die größte Größe hochfüge:
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swDrawModel As SldWorks.ModelDoc2
Dim aView As SldWorks.View
Dim vConfs As Variant
Dim i As Integer
Dim sDrTemplate As String
Dim sOutputFolder As String
Dim file As String
Dim longstatus As Long
Dim longwarnings As Long
Dim swPart As PartDoc
'Dim sa As Object
'Dim swBody As Body2
Dim nBendState As Long
Dim nRetVal As Long
Dim bRet As Boolean
Dim part As DrawingDoc
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'On vérifie si la pièce est bien une tôle
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
nBendState = swModel.GetBendState
If nBendState = 1 Then
'**********Chemin d'export MEP**********
'*******Récup chemin existant***********
sOutputFolder = Left(swModel.GetPathName(), Len(swModel.GetPathName()) - 7)
Debug.Print "Dossier: " & sOutputFolder
'********On vérifie si une MEP est déjà existante********
file = sOutputFolder + ".slddrw"
Debug.Print file
'Pas de MEP existante
If Dir(file) = "" Then
Debug.Print "Dir_file:" & Dir(file)
'**********Chemin du fond de plan modèle**********
Const sDrTemplate As String = "U:\XXX\Mise en plan - Fonds de plan B\A4-DECOUPE-b.DRWDOT"
Set swDraw = swApp.NewDocument(sDrTemplate, 0, 0, 0)
'on passe l'échelle de la feuille à 1:1
Set part = swApp.ActiveDoc
Set swSheet = part.GetCurrentSheet
bRet = swSheet.SetScale(1, 1, True, False)
'Dim swView As SldWorks.View
Set sView = swDraw.CreateFlatPatternViewFromModelView3(swModel.GetPathName, "", 0.105, 0.184, 0#, False, False)
Dim swDrawModel As SldWorks.ModelDoc2
Set swDrawModel = swDraw
swDrawModel.ForceRebuild3 False
swDrawModel.Extension.SaveAs file, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, 0, 0
Debug.Print "Dossier + Nom fichier="; sOutputFolder + ".slddrw"
'On lance le module redimView pour redimensionner la vue
Call moduleRedimView.moduleRedimView
'Une MEP est déjà existante
Else
MsgBox "Fichier déjà existant"
Set part = swApp.OpenDoc6(file, 3, 0, "", longstatus, longwarnings)
End If
'La pièce n'est pas une tôle
Else
MsgBox "Ne fonctionne que sur une pièce de tôlerie"
End If
End Sub
Vielen Dank für Ihre Antwort, sie hilft mir sehr!
Ich versuche jetzt, Ihr Makro mit weiteren Einstellungen zu kompilieren, um 3 Ansichten + Auto-Ribs direkt zu importieren!
(Wenn Sie eine Idee haben, zögern Sie nicht :) )
Das wars! Aber ich habe ein Problem!
-------------------------------
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'On vérifie si la pièce est bien une tôle
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
nBendState = swModel.GetBendState
If nBendState = 1 Then
'*******Chemin d'export MEP******
'*****Récup chemin existant*******
sOutputFolder = Left(swModel.GetPathName(), Len(swModel.GetPathName()) - 7)
Debug.Print "Dossier: " & sOutputFolder
'***On vérifie si une MEP est déjà existante******
file = sOutputFolder + ".slddrw"
Debug.Print file
'Pas de MEP existante
If Dir(file) = "" Then
Debug.Print "Dir_file:" & Dir(file)
'******Chemin du fond de plan modèle*****
Const sDrTemplate As String = "C:\SW2019\SW2011 FICHIERS\FICHIERS SOLIWORKS 2008\Modele de cartouche sous traitance\S-T TOUS CLIENTS\S-T TOUS CLIENTS.drwdot"
Set swDraw = swApp.NewDocument(sDrTemplate, 0, 0, 0)
'on passe l'échelle de la feuille à 2:1
Set part = swApp.ActiveDoc
Set swSheet = part.GetCurrentSheet
bRet = swSheet.SetScale(1, 3, True, False)
'Dim swView As SldWorks.View
boolstatus = part.GenerateViewPaletteViews("F:\svg_plan\AXIMA\Nouveau dossier\test.SLDPRT")
boolstatus = part.Create3rdAngleViews("F:\svg_plan\AXIMA\Nouveau dossier\test.SLDPRT")
Set sView = swDraw.CreateFlatPatternViewFromModelView3(swModel.GetPathName, "", 0.345, 0.175, 0#, False, False)
Dim swDrawModel As SldWorks.ModelDoc2
Set swDrawModel = swDraw
swDrawModel.ForceRebuild3 False
swDrawModel.Extension.SaveAs file, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, 0, 0
Debug.Print "Dossier + Nom fichier="; sOutputFolder + ".slddrw"
'On lance le module redimView pour redimensionner la vue
Call moduleRedimView.moduleRedimView
'Une MEP est déjà existante
Else
MsgBox "Fichier déjà existant"
Set part = swApp.OpenDoc6(file, 3, 0, "", longstatus, longwarnings)
End If
'La pièce n'est pas une tôle
Else
MsgBox "Ne fonctionne que sur une pièce de tôlerie"
End If
End Sub
----------------
Ich kann die automatische MEP ausführen, ABER nur mit dem TEST-Teil, der sich in einem bestimmten Ordner befindet.
Ich möchte den Wert "F:\svg_plan\AXIMA\Neuer Ordner\test" ersetzen. SLDPRT" durch etwas, das mir automatisch das aktuelle Stück wegnehmen würde. Die aufgeklappte Zustandslinie funktioniert gut für jeden Raum, der gerade ausgeführt wird, aber nicht für die 2 Linien, um die 3 automatischen Ansichten zu platzieren.
(Ich versuche auch, die Bemaßungen automatisch hinzuzufügen, die ich normalerweise mit den "Modellobjekten... ")
Danke für Ihre Hilfe!
Ohne es versucht zu haben, wenn Sie Ihre 2 Zeilen durch diese ersetzen:
boolstatus = part.GenerateViewPaletteViews(swModel.GetPathName)
boolstatus = part.Create3rdAngleViews(swModel.GetPathName)
swModel.GetPathName ruft den Pfad des zuvor geöffneten Modells ab
Für die Rippchen:
Sub selectCote()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swDispDim As SldWorks.DisplayDimension
Dim swDim As SldWorks.Dimension
Dim swAnn As SldWorks.Annotation
Dim threadPrefix As String
Dim swSelMgr As SldWorks.SelectionMgr
Dim bSelect As Boolean
Dim sItemName As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Debug.Print "File = " & swModel.GetPathName
Set swView = swDraw.GetFirstView
Do While Not swView Is Nothing
Debug.Print " View = " & swView.Name
Set swDispDim = swView.GetFirstDisplayDimension5
Do While Not swDispDim Is Nothing
Set swAnn = swDispDim.GetAnnotation
Set swDim = swDispDim.GetDimension
Debug.Print " ------------------------------------"
Debug.Print " AnnName = " & swAnn.GetName
Debug.Print " DimFullName = " & swDim.FullName
Debug.Print " DimName = " & swDim.Name
Debug.Print " swDimensionParamType_e type = " & swDim.GetType
Debug.Print " DrivenState = " & swDim.DrivenState
Debug.Print " ReadOnly = " & swDim.ReadOnly
Debug.Print " Value = " & swDim.GetSystemValue2("")
Debug.Print ""
Debug.Print " Arrowside = " & swDispDim.ArrowSide
Debug.Print " TextAll = " & swDispDim.GetText(swDimensionTextAll)
Debug.Print " TextPrefix = " & swDispDim.GetText(swDimensionTextPrefix)
Debug.Print " TextSuffix = " & swDispDim.GetText(swDimensionTextSuffix)
Debug.Print " CalloutAbove = " & swDispDim.GetText(swDimensionTextCalloutAbove)
Debug.Print " CalloutBelow = " & swDispDim.GetText(swDimensionTextCalloutBelow)
threadPrefix = CStr(swDispDim.GetText(swDimensionTextPrefix))
Debug.Print threadPrefix
threadPrefix = Left(threadPrefix, 1)
Debug.Print threadPrefix
'ici on efface la côte si ce n'est pas un taraudage SD
sItemName = ""
sItemName = swAnn.GetName()
Debug.Print "sItemName = " + sItemName + "@" + CStr(swView.Name)
bSelect = swModel.Extension.SelectByID2(sItemName + "@" + CStr(swView.Name), "DIMENSION", 0, 0, 0, True, 0, Nothing, 0)
'ici on termine l'ajout SD
Set swDispDim = swDispDim.GetNext3
'Si le suffixe de la côte est différent de M(xx)-> on supprime
If threadPrefix = "M" Then
Debug.Print "M donc on efface pas)"
swModel.ClearSelection2 True
Else
Debug.Print "Pas M on Efface!"
swModel.EditDelete
swModel.ClearSelection2 True
End If
Loop
Set swView = swView.GetNextView
Loop
Für Sie müssen Sie diesen Teil löschen:
'ici on efface la côte si ce n'est pas un taraudage SD
sItemName = ""
sItemName = swAnn.GetName()
Debug.Print "sItemName = " + sItemName + "@" + CStr(swView.Name)
bSelect = swModel.Extension.SelectByID2(sItemName + "@" + CStr(swView.Name), "DIMENSION", 0, 0, 0, True, 0, Nothing, 0)
'ici on termine l'ajout SD
Set swDispDim = swDispDim.GetNext3
'Si le suffixe de la côte est différent de M(xx)-> on supprime
If threadPrefix = "M" Then
Debug.Print "M donc on efface pas)"
swModel.ClearSelection2 True
Else
Debug.Print "Pas M on Efface!"
swModel.EditDelete
swModel.ClearSelection2 True
End If
Getestet zu werden, aber es scheint mir, dass es die Aufgabe erfüllt
Bearbeiten: oder wieder:
https://forum.solidworks.com/thread/237029
Tolles Dankeschön!
Ich habe den Wert so ersetzt , dass er den Teil in auto einnimmt
Auf der anderen Seite kann ich Ihre zweite Nachricht nicht verstehen? Muss ich einen Song in mein Makro integrieren oder einen vollwertigen erstellen?
Ich habe versucht, das Ganze zu kompilieren, aber ich bekomme jedes Mal mehrere Fehlercodes, wenn ich etwas ändere. Ich weiß nicht wirklich etwas über VBA oder Programmierung, wie Sie verstehen können...
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swDrawModel As SldWorks.ModelDoc2
Dim aView As SldWorks.View
Dim vConfs As Variant
Dim i As Integer
Dim sDrTemplate As String
Dim sOutputFolder As String
Dim file As String
Dim longstatus As Long
Dim longwarnings As Long
Dim swPart As PartDoc
'Dim sa As Object
'Dim swBody As Body2
Dim nBendState As Long
Dim nRetVal As Long
Dim bRet As Boolean
Dim part As DrawingDoc
Dim swView As SldWorks.View
Dim swDispDim As SldWorks.DisplayDimension
Dim swDim As SldWorks.Dimension
Dim swAnn As SldWorks.Annotation
Dim threadPrefix As String
Dim swSelMgr As SldWorks.SelectionMgr
Dim bSelect As Boolean
Dim sItemName As String
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'On vérifie si la pièce est bien une tôle
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
nBendState = swModel.GetBendState
If nBendState = 1 Then
'**********Chemin d'export MEP**********
'*******Récup chemin existant***********
sOutputFolder = Left(swModel.GetPathName(), Len(swModel.GetPathName()) - 7)
Debug.Print "Dossier: " & sOutputFolder
'********On vérifie si une MEP est déjà existante********
file = sOutputFolder + ".slddrw"
Debug.Print file
'Pas de MEP existante
If Dir(file) = "" Then
Debug.Print "Dir_file:" & Dir(file)
'**********Chemin du fond de plan modèle**********
Const sDrTemplate As String = "C:\SW2019\SW2011 FICHIERS\FICHIERS SOLIWORKS 2008\Modele de cartouche sous traitance\S-T TOUS CLIENTS\S-T TOUS CLIENTS.drwdot"
Set swDraw = swApp.NewDocument(sDrTemplate, 0, 0, 0)
'on passe l'échelle de la feuille à 2:1
Set part = swApp.ActiveDoc
Set swSheet = part.GetCurrentSheet
bRet = swSheet.SetScale(1, 3, True, False)
'Dim swView As SldWorks.View
boolstatus = part.GenerateViewPaletteViews(swModel.GetPathName)
boolstatus = part.Create3rdAngleViews(swModel.GetPathName)
Set sView = swDraw.CreateFlatPatternViewFromModelView3(swModel.GetPathName, "", 0.345, 0.175, 0#, False, False)
Dim swDrawModel As SldWorks.ModelDoc2
Set swDrawModel = swDraw
swDrawModel.ForceRebuild3 False
swDrawModel.Extension.SaveAs file, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, 0, 0
Debug.Print "Dossier + Nom fichier="; sOutputFolder + ".slddrw"
'On lance le module redimView pour redimensionner la vue
Call moduleRedimView.moduleRedimView
Do While Not swDispDim Is Nothing
Set swAnn = swDispDim.GetAnnotation
Set swDim = swDispDim.GetDimension
Debug.Print " ------------------------------------"
Debug.Print " AnnName = " & swAnn.GetName
Debug.Print " DimFullName = " & swDim.FullName
Debug.Print " DimName = " & swDim.Name
Debug.Print " swDimensionParamType_e type = " & swDim.GetType
Debug.Print " DrivenState = " & swDim.DrivenState
Debug.Print " ReadOnly = " & swDim.ReadOnly
Debug.Print " Value = " & swDim.GetSystemValue2("")
Debug.Print ""
Debug.Print " Arrowside = " & swDispDim.ArrowSide
Debug.Print " TextAll = " & swDispDim.GetText(swDimensionTextAll)
Debug.Print " TextPrefix = " & swDispDim.GetText(swDimensionTextPrefix)
Debug.Print " TextSuffix = " & swDispDim.GetText(swDimensionTextSuffix)
Debug.Print " CalloutAbove = " & swDispDim.GetText(swDimensionTextCalloutAbove)
Debug.Print " CalloutBelow = " & swDispDim.GetText(swDimensionTextCalloutBelow)
threadPrefix = CStr(swDispDim.GetText(swDimensionTextPrefix))
Debug.Print threadPrefix
threadPrefix = Left(threadPrefix, 1)
Debug.Print threadPrefix
Loop
Set swView = swView.GetNextView
'Une MEP est déjà existante
Else
MsgBox "Fichier déjà existant"
Set part = swApp.OpenDoc6(file, 3, 0, "", longstatus, longwarnings)
End If
'La pièce n'est pas une tôle
Else
MsgBox "Ne fonctionne que sur une pièce de tôlerie"
End If
End Sub
Um es zu starten, kopieren Sie es und fügen Sie es unter dem 1. Teil ein und fügen Sie im 1. hinzu:
mit der Option Dimension, die mit dem Namen des Subs des 2. Teils übereinstimmen muss
Call selectCote
Und Sie müssen löschen
Call moduleRedimView.moduleRedimViewdie ein Sub verwendet, das es in Ihrem Zuhause nicht gibt!
Leider ist das nicht möglich... Die Community hat sich diese Möglichkeit schon lange gewünscht. Keine Rückmeldung von SW ...