12 Replies Latest reply on Jun 22, 2016 6:23 AM by Gabriel Ducan

    VBA to copy properties from part configuration to drawing

    Gabriel Ducan

      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.

       

      1.png2.png

        • Re: VBA to copy properties from part configuration to drawing
          Artem Taturevych

          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

          • Re: VBA to copy properties from part configuration to drawing
            Deepak Gupta

            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.

            • Re: VBA to copy properties from part configuration to drawing
              John Alexander

              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.

                • Re: VBA to copy properties from part configuration to drawing
                  Gabriel Ducan

                  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.

                • Re: VBA to copy properties from part configuration to drawing
                  John Alexander

                  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.

                    • Re: VBA to copy properties from part configuration to drawing
                      Gabriel Ducan

                      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

                    • Re: VBA to copy properties from part configuration to drawing
                      Gabriel Ducan

                      Hello,

                      Nobody can help me with this?

                        • Re: VBA to copy properties from part configuration to drawing
                          John Alexander

                          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

                        • Re: VBA to copy properties from part configuration to drawing
                          John Alexander

                          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.