Bonjour à tous !
Voila je me lance dans la création d'une mise en plan automatique pour des pièces de tôlerie sur Solidworks 2020 SP4
J'arrive à importer automatiquement certaines vues : face, gauche, droite ... MAIS impossible de trouver la fonction pour importer la vue de l'état déplié.. Auriez-vous une idée ?
J'aimerais également que les côtes arrivent automatiquement avec les vues et je n'ai pas trouvé non plus ...
Merci pour aide !
Bonjour,
cela peux fonctionner si la pièce référence a bien une config spécifique "sm-flat" que le plan peux trouver a chaque fois,
ensuite la cotation "magique" est lié a la façon dont la pièce a été dessiné.
Merci pour votre réponse !
La config spécifique de mon état déplié est "SM-FLAT-PATTERN", est-ce que ça peut marcher ? Et comment s'il vous plait ?
Je ne vous ai pas suivi sur la deuxième phrase ..
Merci !
Bonjour,
La configuration flat Pattern n'existe pas tant que vous n'aurez pas créer de mise en plan avec un déplié et ensuite il faudra que toutes vos pièces de tôlerie soit créé de la même manière.
Merci pour votre réponse !
Donc si je suis la première partie de votre phrase ce n'est pas possible mais la suite me dit que c'est possible ? Vous auriez une procédure à suivre ? Une façon de faire à me donner s'il vous plait ?
J'utiliserais cette "mise en plan automatique" uniquement pour les pièces de tôleries simple qui ressemble à la pièce de départ
Merci !
Impossible de faire une mise en plan prédefini avec le flat-pattern jusqu'a la version 2019 pour la 2020 je n'affirmerais rien, mais a mon avis même chose.
La seule solution pour réaliser cette vue déplié en automatique est de faire une macro.
Un exemple de macro que j'utilise à partir de la pièce de tôlerie et qui me créer la mise en plan du flat patern et la met à l'échelle la plus grande en fonction de la feuille de MEP:
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
Merci beaucoup pour votre réponse, ça m'aide pas mal !
J'essaie maintenant de compiler votre macro avec plus de paramètre pour importer directement 3 vues + côtes automatiques !
(si vous avez une idée, n'hésitez pas :) )
Voila je suis arrivé à ça ! Mais j'ai un problème !
-------------------------------
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
----------------
J'arrive à faire la MEP automatique MAIS uniquement avec la pièce TEST qui se trouve dans un certain dossier..
J'aimerais remplacer la valeur "F:\svg_plan\AXIMA\Nouveau dossier\test.SLDPRT" par quelque chose qui me prendrais automatiquement la pièce en cours.. La ligne de l'état déplié fonctionne bien pour chaque pièce en cours mais pas les 2 lignes pour mettres les 3 vues auto..
(Je cherche également à rajouter les côtes en automatique que je met normalement avec la fonction "Objets du modèle...")
Merci pour votre aide !
Sans avoir essayé si tu remplaces tes 2 lignes par ça:
boolstatus = part.GenerateViewPaletteViews(swModel.GetPathName)
boolstatus = part.Create3rdAngleViews(swModel.GetPathName)
swModel.GetPathName récupère le chemin du modèle ouvert précédemment
Pour les côtes:
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
Pour toi il faudra supprimer cette partie:
'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
A tester mais il me semble que ça fait le job
Edit: ou encore:
https://forum.solidworks.com/thread/237029
Super merci !
J'ai remplacé la valeur pour que ça prenne la pièce en auto
Par contre, je n'arrive pas à comprendre ton deuxième message ? Je dois intégrer un morceau dans ma macro ou en faire une à part entière ?
J'ai essayé de compiler le tout mais j'ai plusieurs codes d'erreurs à chaque fois que je modifie un truc. Je ne m'y connait pas vraiment en VBA ni en code comme tu peux le comprendre...
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
Pour la lancer tu copie colle en dessous de la 1ere partie et dans la 1ere tu ajoute:
avec select Cote qui doit correspondre au nom du sub de la 2ème partie
Call selectCote
Et il faut que tu supprime
Call moduleRedimView.moduleRedimViewqui fait appel a un sub qui n'existe pas chez toi!
Malheuresement ce n'est pas possible... cela fait longtemps que la communauté demande cette possibilité. Aucun retour de SW ...