Hello
For the PDF recording part, everything goes well if the name of the file saved in PDF is the same as the drawing.
Unfortunately, today I have to change the macro which works perfectly.
To do this, the saved file, i.e. the PDF, must be renamed using a property of the part. Property name RECORD.
I already use this property in the drawing block, without any problem.
But when saving the file name and $PRPSHEET:"REGISTRATION" and not EN2-A-000-12-A.
I don't know if I'm clear!
Kind regards
Hello
Can you make the code available for analysis plus a screenshot of your drawing properties?
Kind regards
This macro retrieves the template used in the drawing, as well as the enabled configuration of the component
The opens retrieves the configuration-related test property
and saves the plan as a PDF in the same path as the component with the property value
hoping to have answered your request
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim swView As SldWorks.View
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim config as SldWorks.Configuration
Dim Nameproperties As String
Dim Lerrors As Long
Dim Lwarnings As Long
Dim configname as String
Dim lRetVal As Long
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim strRefModelPath As String
Dim NamePlan As String
Dim Path As String
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel.GetType = 3 Then
Set swDraw = swModel
Set swView = swDraw.GetFirstView
NamePlan = swModel.GetTitle
LOOP TO RETRIEVE THE MODEL
Do While Not swView Is Nothing
strRefModelPath = swView.GetReferencedModelName 'retrieves the full path of the file
configname = swView.ReferencedConfiguration 'retrieves the configuration of the view
If strRefModelPath <> "" Then
path = Left(strRefModelPath, InStrRev(strRefModelPath, "\") - 1) 'retrieves the path without the filename
swApp.ActivateDoc (strRefModelPath)
Set swModel = swApp.ActiveDoc
swModel.ShowConfiguration2 (configname) displays the plan configuration
Set config = swModel.GetActiveConfiguration 'retrieves the active configuration of the component
Set cusPropMgr = config. CustomPropertyManager
Nameproperties = CopyCustProps("TEST") retrieves the value of the test property that is specific to the configuration
Exit Do
End If
Set swView = swView.GetNextView
Loop
Else
MsgBox "Please enable a drawing", vbInformation, "Document type error"
End If
Reactivation of the plan
swApp.ActivateDoc NamePlan
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Definition of the registration noma
NamePlan=path&\"&Nameproperties&".pdf"
PDF Registration
wasResolved = swModelDocExt.SaveAs(NamePlan, 0, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, Lerrors, Lwarnings)
End Sub
Function CopyCustProps(PropertyName) As String
lRetVal = cusPropMgr.Get5(PropertyName, False, ValOut, ResolvedValOut, wasResolved)
CopyCustProps = ResolvedValOut
End Function
Hello
Same request as d.roger. If the property is used in the plan, it is easier to loop in the notes of the cartouche than to retrieve the information via a view and the 3D attached to it (as long as there are different views with different models attached, it quickly becomes complicated).
Wholesale:
Const cProp = "$PRPSHEET:""ENREGISTREMENT"""
Dim sFilename as string
Set swDraw = swModel
Set swView = swDraw.GetFirstView 'Active le fond de plan
Set swNote = swView.GetFirstNote
swModel.ClearSelection2 (True)
Do While Not swNote Is Nothing
Set swAnn = swNote.GetAnnotation
If swNote.PropertyLinkedText = cProp Then
sFilename = swNote.GetText 'ajouter le traitement pour formater correctement le nom d'enregistrement
End If
Set swNote = swNote.GetNext
Loop
Hello
Thank you for your answers.
gdm I have an error "compilation: variable not defined" with "swSaveAsOptions_e"
Of course d.roger below the code part for the registration.
Cyril.f yes the property and used in the drawing, I created a Note with the Name of the attribute "INFO_QUALITE05"
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
' Added control of the correct file
If Part Is Nothing Then
MsgBox "No files are currently open."
Exit Sub ' If no model is currently loaded, then exit
End If
' Determine the document type. If the document is a drawing, then send a message to the user.
If (Part.GetType <> 3) Then '1Part 2Assembly 3Document
MsgBox "This macro only applies to a drawing"
Exit Sub
End If
File = Part.GetPathName
If File = "" Then
MsgBox "This macro requires the file to be saved beforehand"
Exit Sub
End If
path = left(file, InStrRev(File, "\"))
FileName = Part.GetCustomInfoValue("", "REGISTRATION")
Set swModelDocExt = Part.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
Set swdraw = Part
vSheetNames = swdraw. GetSheetNames
Sun i As Long
Sun j As Long
j = 0
ReDim strSheetName(UBound(vSheetNames))
For i = 0 To UBound(vSheetNames)
If InStr(vSheetNames(i), "Plan") <> 0 Then
strSheetName(j) = vSheetNames(i)
j = d + 1
End If
Next
varSheetName = strSheetName
If swExportPDFData Is Nothing Then MsgBox "Nothing"
boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, varSheetName)
'Addition for Part Property
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swdraw = swModel
Set swview = swdraw. GetFirstView
Set swview = swview. GetNextView
v = swview. GetVisibleComponents
Set comp = v(0)
Set swmod = comp. GetModelDoc2
Propname = swmod. GetCustomInfoNames
Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
Debug.Print swmod. GetCustomInfoValue(config, "DESCRIPTION")
REGISTRATION
boolstatus = swModelDocExt.SaveAs(Path & "\" & FileName & "" & swmod. GetCustomInfoValue(config, "INFO_QUALITE05") & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)
You have to activate the attachment reference
or replace swSaveAsOptions_e.swSaveAsOptions_Silent with 1 in the code
Thank you gdm, it's OK for this passage by replacing by 1 in the code I'm under Solidworks 2013.
There is another runtime error '438': Property or method not handled ^by this object at the level of the RetVal = cusPropMgr.Get5(PropertyName, False, ValOut, ResolvedValOut, wasResolved)
Kind regards
The Get5 function did not yet exist for the 2013 version, to be replaced by Get4 and necessarily you have to change the number of arguments of the function !!
Thank you d.roger it works better!
Even if unfortunately I don't understand everything about macro, I'll take it back when I have a little more time.
In any case, it does the job, thank you to you.