Hello,
I need a VBA to copy properties from part configuration to drawing.
I found some VBA but they copy the properties from custom not from configuration specific.
Hi Gabriel,
You can use #TASK . Just add the Copy Custom Properties task Version 2 which can copy configuration specific and optionally generic custom properties into the drawing.
Thanks,
Artem
Thank you for the answer but is not what i am looking for. I need the vba code.
You should be able to change those codes easily. If you're not able to do that then share that macro here and someone would help to fix that.
Somewhere in your VBA script, it will have a call to get the CustomPropertyManager("").
The call to that CustomPropertyManager getter takes the configuration name as an argument. In your case, your macro is not specifying a configuration (hence the empty string "") so it is grabbing the non configuration-specific version of the CustomPropertyManager.
Hello,
I have this script.
'Export Drawing Sheets As DWG.swp ------------- 04/23/14
'
'Description: Macro to export Drawing Sheets As DWG with File Name, Revision, Sheet Name and Total Sheets as file name.
'
'Precondition: Any active drawing file
'
'Postconditions: Drawing File sheets are saved as DWG files in the Desktop.
'
' Please back up your data before use and USE AT OWN RISK
'
' This macro is provided as is. No claims, support, refund, safety net, or
' warranties are expressed or implied. By using this macro and/or its code in
' any way whatsoever, the user and any entities which the user represents,
' agree to hold the authors free of any and all liability. Free distribution
' and use of this code in other free works is welcome. If any portion of
' this code is used in other works, credit to the authors must be placed in
' that work within a user viewable location (e.g., macro header). All other
' forms of distribution (i.e., not free, fee for delivery, etc) are prohibited
' without the expressed written consent by the authors. Use at your own risk!
' ------------------------------------------------------------------------------
' Written by: Deepak Gupta (http://gupta9665.wordpress.com/)
' -----------------------------------------------------------------------------
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc2
Dim swmod As SldWorks.ModelDoc2
Dim swdraw As SldWorks.DrawingDoc
Dim swview As SldWorks.View
Dim v As Variant
Dim Propname As Variant
Dim evval As Variant
Dim model As String
Dim error As Long
Dim warning As Long
Dim config As Variant
Dim addstatus As Long
Dim i As Integer
Dim comp As SldWorks.Component2
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Sub main()
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("")
For i = 0 To UBound(Propname)
evval = swmod.GetCustomInfoValue(config, Propname(i))
addstatus = swCustPropMgr.Add2(Propname(i), swCustomInfoText, evval)
evval = ""
Next
Dim vSheetName As Variant
Dim nErrors As Long
Dim nWarnings As Long
Dim nRetval As Long
Dim bShowMap As Boolean
Dim nNumSheet As Long
Dim bRet As Boolean
Dim FileName As String
Dim Path As String
Dim Fileprop As String
Path = Environ("CurDir$")
Set swApp = Application.SldWorks
swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfActiveSheetOnly
Set swmodel = swApp.ActiveDoc
' Is document active?
If swmodel Is Nothing Then
swApp.SendMsgToUser2 "A Drawing document must be active.", swMbWarning, swMbOk
Exit Sub
End If
' Is it a Drawing document?
If swmodel.GetType <> swDocDRAWING Then
swApp.SendMsgToUser2 "A Drawing document must be active.", swMbWarning, swMbOk
Exit Sub
End If
Set swdraw = swmodel
' Rebuild the Drawing
swdraw.ForceRebuild3 (False)
vSheetName = swdraw.GetSheetNames
For i = 0 To UBound(vSheetName)
bRet = swdraw.ActivateSheet(vSheetName(i))
' Zoom to Fit the Sheet
swdraw.ViewZoomtofit2
'Set File Name Here
Fileprop = swmodel.CustomInfo("Number")
FileName = Mid(swmodel.GetPathName, InStrRev(swmodel.GetPathName, "\") + 1)
FileName = Left(FileName, InStrRev(FileName, ".") - 1)
FileName = Path & Fileprop & ".DWG"
bRet = swmodel.SaveAs4(FileName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, nErrors, nWarnings)
Next i
' Switch back to first sheet
bRet = swdraw.ActivateSheet(vSheetName(0))
End Sub
I need to grab the Number from the Configuration part and save the DWG file with this Number.
Fileprop = swmodel.CustomInfo("Number")
Looks like the old style.
Try adding the following 3 variable declarations:
Dim configuration_name as string
Dim dmmy as string
Dim bRet as Boolean
And replacing the line containing "CustomInfo" with the following two lines:
configuration_name = "configuration name" 'make this the configuration name that you want to get properties for
bRet = swmodel.extension.custompropertymanager(configuration_name).get4("Number", True, FileProp, dmmy): debug.assert bRet
Where it says "configuration name" put the name of the specific configuration that you want the custom property for.
Hello
I started with this code to bring the number from part configuration to the drawing Custom Info.
My part have at least 4 configurations.
I need to bring the number to my drawing Custom Info for future use of the DWG export code.
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc2
Dim swmod As SldWorks.ModelDoc2
Dim swdraw As SldWorks.DrawingDoc
Dim swview As SldWorks.VIEW
Dim v As Variant
Dim Propname As Variant
Dim evval As Variant
Dim model As String
Dim error As Long
Dim warning As Long
Dim config As Variant
Dim addstatus As Long
Dim i As Integer
Dim comp As SldWorks.Component2
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim strDoRebuild As String
Sub main()
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("")
For i = 0 To UBound(Propname)
evval = swmod.GetCustomInfoValue(config, Propname(i))
addstatus = swCustPropMgr.Add2(Propname(i), swCustomInfoText, evval)
evval = ""
Next
strDoRebuild = MsgBox("Rebuild drawing now?", vbYesNo)
If strDoRebuild = vbYes Then
strDoRebuild = MsgBox("Number copied", vbOKOnly)
End If
End Sub
Just to be clear, you have a drawing of a Part. The part contains several configurations. You want to get a Custom Property named "Number" from each configuration and assign it to the drawing's Custom Properties? Is Number the same in all configurations of the part?
I'm going to assume that Number is the same in all configurations. If it isn't, you need to come up with a naming convention for each configuration's number in the drawing document custom properties.
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc2
Dim swmod As SldWorks.ModelDoc2
Dim swdraw As SldWorks.DrawingDoc
Dim swview As SldWorks.VIEW
Dim v As Variant
Dim Propname As Variant
Dim evval As Variant
Dim model As String
Dim error As Long
Dim warning As Long
Dim config As Variant
Dim addstatus As Long
Dim i As Integer
Dim comp As SldWorks.Component2
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim strDoRebuild As String
Dim config_name as string
Dim str_dmmy as string
Dim lRet as Long
Sub main()
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
config_name = swmod.configurationmanager.activeconfiguration.name
Set swCustPropMgr = swmod.Extension.CustomPropertyManager(config_name)
bRet = swCustPropMgr.get4("Number", false, evval, str_dmmy)
lRet = swModel.extension.custompropertyManager("").add2("Number", swCustomInfoType_e.swCustomInfoText, evval)
strDoRebuild = MsgBox("Rebuild drawing now?", vbYesNo)
If strDoRebuild = vbYes Then
strDoRebuild = MsgBox("Number copied", vbOKOnly)
End If
End Sub
Hello,
Thank you for reply.
The number is unique for every configuration.
I should point out that drawings cannot have multiple configs - so you won't be able to build matching configurations and assign corresponding numbers to them in the drawing.
Hello,
Thank you for your reply.
How can i use this $PRPSHEET:"Number" in a VBA?
