Here I am starting to create an automatic drawing for sheet metal parts on Solidworks 2020 SP4
I can automatically import certain views: front, left, right... BUT unable to find the function to import the unfolded state view. Do you have an idea?
I would also like the ribs to arrive automatically with the views and I didn't find either...
The flat pattern configuration does not exist until you have created a drawing with an unfolded and then all your sheet metal parts will have to be created in the same way.
So if I follow the first part of your sentence, it's not possible, but the rest tells me that it's possible? Do you have a procedure to follow? Any way to give me please?
I would use this "automatic drawing " only for simple sheet metal parts that looks like the starting part
An example of a macro that I use from the sheet metal part and that I create the drawing of the patern flat and scale it to the largest according to the MEP sheet:
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
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
----------------
I can do the automatic MEP BUT only with the TEST part which is in a certain folder.
I'd like to replace the value "F:\svg_plan\AXIMA\New folder\test. SLDPRT" by something that would automatically take the current piece from me. The unfolded state line works well for each room in progress but not the 2 lines to put the 3 auto views.
(I'm also looking to add the dimensions in automatic that I normally put with the "Model objects... ")
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
For you you will have to delete this part:
'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
To be tested but it seems to me that it does the job
I replaced the value so that it takes the part in auto
On the other hand, I can't understand your second message? Do I have to integrate a song into my macro or make a full-fledged one?
I tried to compile the whole thing but I get several error codes every time I modify something. I don't really know anything about VBA or coding as you can understand...
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