Hallo @all,
Ik ben op zoek naar een manier om de bestaande bladformaten te vervangen door een ander velformaat, afhankelijk van het formaat (A0, A1, A2 enz.) in batch voor alle tekeningen in een map.
Het verbaast me dat ik de optie niet kon vinden in MyCadTools.
Bij voorbaat dank.
Groeten Andreas
U kunt een basismap vervangen/herladen met integratie voor een tekenset:
Anders kunt u het doen met een macro (hier laden we hetzelfde formaat opnieuw met een nieuwe sjabloon-> om aan te passen voor uw formaten):
Option Explicit
'Site avec exemple: https://www.lynkoa.com/forum/mises-en-plan/modifier-une-note-sur-un-fond-de-plan-solidworks-avec-une-macro
Public Enum swDocumentTypes_e
swDocNONE = 0 ' Used to be TYPE_NONE
swDocPART = 1 ' Used to be TYPE_PART
swDocASSEMBLY = 2 ' Used to be TYPE_ASSEMBLY
swDocDRAWING = 3 ' Used to be TYPE_DRAWING
End Enum
Dim swSheet As SldWorks.Sheet
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swModelDocExt As ModelDocExtension
Dim sTemplate As String
Dim stemplatepath As String
Dim Count As Integer
Dim vSheetNameArr As Variant
Dim vSheetName As Variant
Dim vSheetProps As Variant
Dim bRet As Boolean
Dim tolerie As Boolean
Dim swView As SldWorks.View
Dim userName As String
Dim cDirTemplate As String
Dim cTemplateA4 As String
Dim cTemplateA4_Laser As String
Dim cTemplateA3 As String
Dim cTemplateA2 As String
Dim cTemplateA1 As String
Dim cTemplateA0 As String
Dim cTemplateA0plus As String
Option Explicit
'Site avec exemple: https://www.lynkoa.com/forum/mises-en-plan/modifier-une-note-sur-un-fond-de-plan-solidworks-avec-une-macro
Public Enum swDocumentTypes_e
swDocNONE = 0 ' Used to be TYPE_NONE
swDocPART = 1 ' Used to be TYPE_PART
swDocASSEMBLY = 2 ' Used to be TYPE_ASSEMBLY
swDocDRAWING = 3 ' Used to be TYPE_DRAWING
End Enum
Dim swSheet As SldWorks.Sheet
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swModelDocExt As ModelDocExtension
Dim sTemplate As String
Dim stemplatepath As String
Dim Count As Integer
Dim vSheetNameArr As Variant
Dim vSheetName As Variant
Dim vSheetProps As Variant
Dim bRet As Boolean
Dim tolerie As Boolean
Dim swView As SldWorks.View
Dim userName As String
Dim cDirTemplate As String
Dim cTemplateA4 As String
Dim cTemplateA4_Laser As String
Dim cTemplateA3 As String
Dim cTemplateA2 As String
Dim cTemplateA1 As String
Dim cTemplateA0 As String
Dim cTemplateA0plus As String
Sub main()
'Variable à remplacer lors d'un changement de fond de plan
'Constantes à remplacer lors de changement de fond de plan
cDirTemplate = " C:\xxx\xxx\Fond de plan C\" 'Mettre le chemin d'accès aux fonds de plans sous ce format: C:\xxx\xxx\
cTemplateA4 = "a4-c.slddrt" 'A renommer si vos templates s'appelle autrement
cTemplateA4_Laser = "a4-DECOUPE-c.slddrt"
cTemplateA3 = "a3-c.slddrt"
cTemplateA2 = "a2-c.slddrt"
cTemplateA1 = "a1-c.slddrt"
cTemplateA0 = "A0-c.slddrt"
cTemplateA0plus = "A0+-c.slddrt"
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox ("Pas de document ouvert")
Else
If swModel.GetType <> 3 Then
MsgBox ("Il ne s'agît pas d'une mise en plan")
Else
Set swDraw = swModel
Set swModelDocExt = swModel.Extension
vSheetNameArr = swDraw.GetSheetNames
For Each vSheetName In vSheetNameArr
Debug.Print vSheetName
bRet = swDraw.ActivateSheet(vSheetName): Debug.Assert bRet
Set swSheet = swDraw.GetCurrentSheet
'Ajout SD test nom template pas utile dans la macro (pour version future?):
Set swSheet = swDraw.GetCurrentSheet
sTemplate = Mid(swSheet.GetTemplateName, InStrRev(swSheet.GetTemplateName, "\") + 1)
Debug.Print sTemplate
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView
'On récupère le nom de la config de la vue
Debug.Print "Nom de la vue" & swView.Name
Debug.Print "Configuration" & swView.ReferencedConfiguration
vSheetProps = swSheet.GetProperties
Debug.Print "vSheetProps(0)=" & vSheetProps(0)
If vSheetProps(0) = "7" And swView.ReferencedConfiguration Like "*FLAT-PATTERN" Then 'A4
stemplatepath = cDirTemplate & cTemplateA3
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA4_Laser
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False)
ElseIf vSheetProps(0) = "7" Then 'A4
stemplatepath = cDirTemplate & cTemplateA3
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA4
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False) 'A2
ElseIf vSheetProps(0) = "8" Then 'A3
stemplatepath = cDirTemplate & cTemplateA4
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA3
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False) 'A2
ElseIf vSheetProps(0) = "9" Then
stemplatepath = cDirTemplate & cTemplateA4
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA2
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False)
ElseIf vSheetProps(0) = "10" Then 'A1
stemplatepath = cDirTemplate & cTemplateA4
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA1
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False)
ElseIf vSheetProps(0) = "11" Then 'A0
stemplatepath = cDirTemplate & cTemplateA4
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA0
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False)
ElseIf vSheetProps(0) = "11" Then 'A0+
stemplatepath = cDirTemplate & cTemplateA4
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
stemplatepath = cDirTemplate & cTemplateA0plus
bRet = swDraw.SetupSheet4(swSheet.GetName, vSheetProps(0), 12, vSheetProps(2), vSheetProps(3), True, stemplatepath, 0#, 0#, "")
swModel.ForceRebuild3 (False)
ElseIf vSheetProps(0) <> "7" Then 'Pour les formats un peu exotiques non gérés
If vSheetProps(0) <> "8" Then
If vSheetProps(0) <> "9" Then
If vSheetProps(0) <> "10" Then
If vSheetProps(0) <> "11" Then
If vSheetProps(0) <> "12" Then
MsgBox "Le fond de plan ne correspond à aucune trame connue" & vbCrLf & "Aucun changement appliqué"
Exit Sub
End If: End If: End If: End If: End If
End If
Next
End If
End If
swModel.Save2 (True) 'Sauvegarde des changements
End Sub
Om de macro toe te passen op een tekenbatch, is het mogelijk om dit te doen via Integratie
Met een voorwaarde op Systematic, dan de bewerking op Diversen, het starten van een macro.
Na het elimineren van een paar applicatiefouten van mijn kant, werkte het perfect.
Hartelijk dank en vriendelijke groeten uit het Zwarte Woud / Duitsland
Andreas
Uit nieuwsgierigheid, welke oplossing heb je gekozen?
Macro
Macro + integratie
Alleen integratie